[vhffs-dev] [723] Ok, so we now have an ObjectFactory.

[ Thread Index | Date Index | More vhffs.org/vhffs-dev Archives ]


Revision: 723
Author:   beuss
Date:     2007-07-13 13:12:22 +0000 (Fri, 13 Jul 2007)

Log Message:
-----------
Ok, so we now have an ObjectFactory. This way we can have the benefits of
polymorphism.

Modified Paths:
--------------
    trunk/vhffs-api/src/Vhffs/Group.pm
    trunk/vhffs-api/src/Vhffs/Object.pm
    trunk/vhffs-api/src/Vhffs/Services/Cvs.pm
    trunk/vhffs-api/src/Vhffs/Services/DNS.pm
    trunk/vhffs-api/src/Vhffs/Services/Httpd.pm
    trunk/vhffs-api/src/Vhffs/Services/Mail.pm
    trunk/vhffs-api/src/Vhffs/Services/Mailing.pm
    trunk/vhffs-api/src/Vhffs/Services/Mysql.pm
    trunk/vhffs-api/src/Vhffs/Services/Postgres.pm
    trunk/vhffs-api/src/Vhffs/Services/Repository.pm
    trunk/vhffs-api/src/Vhffs/Services/Svn.pm
    trunk/vhffs-api/src/Vhffs/User.pm

Added Paths:
-----------
    trunk/vhffs-api/src/Vhffs/ObjectFactory.pm
    trunk/vhffs-api/src/Vhffs/Services.pm


Modified: trunk/vhffs-api/src/Vhffs/Group.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Group.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Group.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -349,8 +349,17 @@
 }
 
 
+=head2 get_label
 
+See C<Vhffs::Object::get_label>.
 
+=cut
+
+sub get_label {
+    my $self = shift;
+    return $self->{groupname};
+}
+
 sub get_quota
 {
 	my $self = shift;
@@ -648,12 +657,20 @@
     my ($class, $main, $gid, $oid, $owner_uid, $groupname, $passwd, $quota, $quota_used, $date_creation, $description, $state) = @_;
     my $self = $class->SUPER::_new($main, $oid, $owner_uid, $gid, $date_creation, $description, $state, Vhffs::Constants::TYPE_GROUP);
     return undef unless(defined $self);
+
     foreach (qw (gid groupname passwd quota quota_used) ) {
         eval '$self->{$_} = $'.$_;
     }
     return $self;
 }
 
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT gid, groupname, passwd, quota, quota_used FROM
+        vhffs_groups WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 1;
 
 __END__

Modified: trunk/vhffs-api/src/Vhffs/Object.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Object.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Object.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -272,6 +272,18 @@
 	return $self->{'state'};
 }
 
+=head2 get_label
+
+Returns a label for this object that can be used to display information.
+Should be redefined in every subclasses (for example, Httpd returns the
+servername).
+
+=cut
+
+sub get_label {
+    return "????"
+}
+
 sub set_status
 {
 	my ($self , $value);
@@ -479,6 +491,45 @@
 }
 
 
+=head2 fill_object
+
+    my $svc = Vhffs::Service::XXX::fill_object($obj);
+
+This method should be overloaded in every subclasses.
+Its goal is to transform a given object into a more
+specialized subclass.
+=cut
+sub fill_object {
+    my ($class, $obj) = @_;
+    warn "Unimplemented fill_object method\n";
+    return $obj;
+}
+
+=head2 _fill_object
+
+    $svc = $class->SUPER::_fill_object($obj, $sql);
+
+Convenience method to implement fill_object in subclasses.
+
+Adds fields returned by C<$sql> query to object $obj and, if the query succeed,
+bless the object whith C<$class>.
+
+C<$sql> must contain a placeholder (?) which will be filled with the object
+OID. See subclasses implementation of C<fill_object> for more details.
+
+=cut
+
+sub _fill_object {
+    my ($class, $obj, $sql) = @_;
+    my $dbh = $obj->get_db_object();
+    my $res = $dbh->selectrow_hashref($sql, undef, $obj->get_oid);
+    return $obj unless(defined $res);
+    foreach(keys %$res) {
+        $obj->{$_} = $res->{$_};
+    }
+    return bless($obj, $class);
+}
+
 1;
 			    
 __END__

Added: trunk/vhffs-api/src/Vhffs/ObjectFactory.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/ObjectFactory.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/ObjectFactory.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -0,0 +1,95 @@
+# Vhffs::ObjectFactory - Fetches an object depending on his type.
+# Copyright (c) vhffs project and its contributors
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+#   notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in
+#    the documentation and/or other materials provided with the
+#    distribution.
+# 3. Neither the name of vhffs nor the names of its contributors
+#    may be used to endorse or promote products derived from this
+#    software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+=head1 NAME
+
+Vhffs::ObjectFactory - Factory for VHFFS Objects.
+
+=head1 SYNOPSYS
+
+This class can be used to fetch a full object without any knowledge of its
+type. This way, we can use polymorphism.
+
+=head1 METHODS
+
+=cut
+
+package Vhffs::ObjectFactory;
+
+use strict;
+use Vhffs::Constants;
+use Vhffs::User;
+use Vhffs::Group;
+use Vhffs::Services;
+
+# Matches an object class based on its type
+my @OBJECTS_BY_TYPE;
+
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_USER] = 'Vhffs::User';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_GROUP] = 'Vhffs::Group';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_HTTPD] = 'Vhffs::Services::Httpd';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_REPOSITORY] = 'Vhffs::Services::Repository';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_MYSQL] = 'Vhffs::Services::Mysql';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_PGSQL] = 'Vhffs::Services::Postgres';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_CVS] = 'Vhffs::Services::Cvs';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_SVN] = 'Vhffs::Services::Svn';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_DNS] = 'Vhffs::Services::DNS';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_MAIL] = 'Vhffs::Services::Mail';
+$OBJECTS_BY_TYPE[Vhffs::Constants::TYPE_ML] = 'Vhffs::Services::Mailing';
+
+=head2 fetch_object
+
+    my $obj = Vhffs::ObjectFactory::fetch_object($vhffs, $oid);
+
+Returns the object whose oid is C<$oid>. Actually the returned entity is a
+subclass of Vhffs::Object, allowing use of polymorphism (eg. calling get_label
+will call the subcall get_label method).
+
+=cut
+
+sub fetch_object {
+    my ($vhffs, $oid) = @_;
+    my $obj = Vhffs::Object::get_by_oid($vhffs, $oid);
+    return undef unless(defined $obj);
+    my $class = $OBJECTS_BY_TYPE[$obj->get_type];
+    if(defined $class) {
+        $obj = $class->fill_object($obj);
+    }
+    return $obj;
+}
+
+return 1;
+
+__END__
+
+=head1 AUTHORS
+
+Sébastien Le Ray <beuss AT tuxfamily DOT org>

Modified: trunk/vhffs-api/src/Vhffs/Services/Cvs.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Cvs.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Cvs.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -163,6 +163,10 @@
 	}
 }
 
+sub get_label {
+    return $_[0]->{cvsroot};
+}
+
 sub get_cvsroot
 {
 	my $self = shift;
@@ -213,6 +217,19 @@
     return $self;
 }
 
+
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>.
+
+=cut
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT cvsroot, cvs_id, public FROM vhffs_cvs
+        WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 sub getall
 {
     my ($vhffs, $state, $name, $group) = @_;

Modified: trunk/vhffs-api/src/Vhffs/Services/DNS.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/DNS.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/DNS.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -193,57 +193,74 @@
     return 1;
 }
 
-=pod
+=head2 fill_object
 
-=head2 get_by_domainname
+See C<Vhffs::Object::fill_object>.
 
-    my $dns = Vhffs::Services::DNS::get_by_domainname($main, $domainname);
-    die('Domain not found') unless(defined $dns);
+=cut
 
-Fetches the DNS object whose domainname is $domainname. Returned object is fully
-functionnal. A, NS, CNAME, I<etc.> records are filled and accessible using
-C<$dns->get_xxx_type>.
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT dns_id, domain, ns, mbox, serial, refresh, retry,
+        expire, minimum, ttl FROM vhffs_dns WHERE object_id = ?};
+    $obj = $class->SUPER::_fill_object($obj, $sql);
+   
+    if($obj->isa('Vhffs::Services::DNS')) {
+        my @records = fetch_records($obj->get_db_object, $obj->{dns_id});
+        $obj->{A} = $records[0];
+        $obj->{NS} = $records[1];
+        $obj->{CNAME} = $records[2];
+        $obj->{MX} = $records[3];
+        $obj->{SRV} = $records[4];
+        $obj->{AAAA} = $records[5];
+        $obj->{TXT} = $records[6];
+    }
+    
+    return $obj;
+}
 
+=head2 fetch_records
+
+    my @records = fetch_records($dbh, $dns_id);
+
+Returns an array of hashrefs containing all records for a given zone. The
+records are pushed in the following order: A, NS, CNAME, MX, SRV, AAAA, TXT.
+
+Internal module use only.
+
 =cut
 
-sub get_by_domainname($$)
-{
-    my ($main, $name) = @_;
-    
-    my $sql = 'SELECT d.dns_id, d.domain, o.owner_gid, d.ns, d.mbox, d.serial, d.refresh, d.retry, d.expire, d.minimum, d.ttl, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_dns d INNER JOIN vhffs_object o ON o.object_id = d.object_id WHERE d.domain = ?';
 
-    my $dbh = $main->get_db_object();
-    my @params;
-    return undef unless(@params = $dbh->selectrow_array($sql, undef, $name));
-    my $dns_id = $params[0];
-
+sub fetch_records {
+    my ($dbh, $dns_id) = @_;
+    my @records;
     # Fetches A records
-    $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = \'A\'';
+    my $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = \'A\'';
     my $sth = $dbh->prepare($sql);
     $sth->execute($dns_id);
     my $a = $sth->fetchall_hashref('id');
-    push @params, $a;
+    push @records, $a;
 
     # Fetches NS records
     $sql = 'SELECT id, zone, name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
     $sth = $dbh->prepare($sql);
     $sth->execute($dns_id, 'NS');
     my $ns = $sth->fetchall_hashref('id');
-    push @params, $ns;
+    push @records, $ns;
 
     # Fetches CNAME records
     $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
     $sth = $dbh->prepare($sql);
     $sth->execute($dns_id, 'CNAME');
     my $cname = $sth->fetchall_hashref('id');
-    push @params, $cname;
+    push @records, $cname;
 
     # Fetches MX records
     $sql = 'SELECT id, zone, name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
     $sth = $dbh->prepare($sql);
     $sth->execute($dns_id, 'MX');
     my $mx = $sth->fetchall_hashref('id');
-    push @params, $mx;
+    push @records, $mx;
 
     # Fetches SRV records
     $sql = 'SELECT id, zone, name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
@@ -258,23 +275,48 @@
         delete $rr->{data};
         $srv->{$rr->{id}} = $rr;
     }
-    push @params, $srv;
+    push @records, $srv;
 
     # Fetches AAAA records
     $sql = 'SELECT id, zone, (CASE WHEN name = \'\' THEN \'@\' ELSE name END) AS name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = \'AAAA\'';
     $sth = $dbh->prepare($sql);
     $sth->execute($dns_id);
     my $aaaa = $sth->fetchall_hashref('id');
-    push @params, $aaaa;
+    push @records, $aaaa;
 
     # Fetches TXT records
     $sql = 'SELECT id, zone, name, type, data, aux, ttl FROM vhffs_dns_rr WHERE zone = ? AND type = ?';
     $sth = $dbh->prepare($sql);
     $sth->execute($dns_id, 'TXT');
     my $txt = $sth->fetchall_hashref('id');
-    push @params, $txt;
+    push @records, $txt;
 
+}
 
+=head2 get_by_domainname
+
+    my $dns = Vhffs::Services::DNS::get_by_domainname($main, $domainname);
+    die('Domain not found') unless(defined $dns);
+
+Fetches the DNS object whose domainname is $domainname. Returned object is fully
+functionnal. A, NS, CNAME, I<etc.> records are filled and accessible using
+C<$dns->get_xxx_type>.
+
+=cut
+
+sub get_by_domainname($$)
+{
+    my ($main, $name) = @_;
+    
+    my $sql = 'SELECT d.dns_id, d.domain, o.owner_gid, d.ns, d.mbox, d.serial, d.refresh, d.retry, d.expire, d.minimum, d.ttl, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_dns d INNER JOIN vhffs_object o ON o.object_id = d.object_id WHERE d.domain = ?';
+
+    my $dbh = $main->get_db_object();
+    my @params;
+    return undef unless(@params = $dbh->selectrow_array($sql, undef, $name));
+    my $dns_id = $params[0];
+
+    push @params, fetch_records($dbh, $dns_id);
+
     return _new Vhffs::Services::DNS($main, @params);
 }
 
@@ -908,6 +950,17 @@
 # ACCESSORS
 ########################################
 
+=head2 get_label
+
+See C<Vhffs::Object::get_label>.
+
+=cut
+
+sub get_label {
+    my $self = shift;
+    return $self->{domain};
+}
+
 sub get_dns_id
 {
     my $self = shift;

Modified: trunk/vhffs-api/src/Vhffs/Services/Httpd.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Httpd.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Httpd.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -114,8 +114,6 @@
 	$self->SUPER::commit;
 }
 
-=pod
-
 =head2 get_servername
 
     my $servername = $httpd->getservername;
@@ -130,6 +128,18 @@
 	return $self->{'servername'};
 }
 
+
+=head2 get_label
+
+See C<Vhffs::Object::get_label>.
+
+=cut
+
+sub get_label {
+    my $self = shift;
+    return $self->{servername};
+}
+
 sub get_title
 {
 	my $self = shift;
@@ -275,14 +285,25 @@
     return $objs;
 }
 
-=pod
+=head2 fill_object
 
+See C<Vhffs::Object::fill_object>.
+
+=cut
+
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT httpd_id, servername FROM vhffs_httpd
+        WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 =head2 get_by_servername
 
     my $httpd = Vhffs::Services::Httpd::get_by_servername($main, $servername);
     die("Webarea $servername not found\n") unless(defined $httpd);
 
-Fetches the webarea whose address is $servername.
+Fetches the webarea whose address is C<$servername>.
 
 =cut
 
@@ -297,9 +318,15 @@
     return _new Vhffs::Services::Httpd($main, @params);
 }
 
-# Return a reference on an array, each fiel is a hash with two fields
-# letter and count (count is the number of websites starting with letter).
-# 0 site letters aren't stored.
+
+=head2 get_used_letters
+
+Returns a reference on an array, each field is a hash with two fields
+letter and count (count is the number of websites starting with letter).
+0 site letters aren't stored.
+
+=cut
+
 sub get_used_letters {
     my $main = shift;
     my $state = shift;
@@ -316,7 +343,7 @@
     my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, $state, Vhffs::Constants::TYPE_HTTPD);
     return undef unless(defined($self));
 
-    $self->{http_id} = $http_id;
+    $self->{http_id} = $httpd_id;
     $self->{servername} = $servername;
     
     return $self;

Modified: trunk/vhffs-api/src/Vhffs/Services/Mail.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mail.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Mail.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -334,7 +334,6 @@
 	$request->execute;
 }
 
-
 # Returns a hashref with all forwards
 # Ths key of this hash is the local part for the forward
 sub get_forwards
@@ -389,6 +388,11 @@
 	return $self->{'boxes'};
 }
 
+sub get_label {
+    my $self = shift;
+    return $self->{domain};
+}
+
 sub get_title
 {
 	my $self = shift;
@@ -491,21 +495,69 @@
     return undef unless(@params = $dbh->selectrow_array($sql, undef, $domain));
 
     # We now need the boxes and forwards
-    $sql = 'SELECT domain, local_part, domain_hash, password_hash, mbox_name, password_hash AS password, nospam, novirus FROM vhffs_boxes WHERE domain = ?';
-    my $sth = $dbh->prepare($sql);
-    $sth->execute($domain);
-    my $boxes = $sth->fetchall_hashref('local_part');
+    my $boxes = fetch_boxes($dbh, $domain);
+    my $forwards = fetch_forwards($dbh, $domain);
 
-    $sql = 'SELECT domain, local_part, remote_name, password FROM vhffs_forward WHERE domain = ?';
-    $sth = $dbh->prepare($sql);
-    $sth->execute($domain);
-    my $forwards = $sth->fetchall_hashref('local_part');
 
-
     return _new Vhffs::Services::Mail($main, @params, $boxes, $forwards);
 
 }
 
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>.
+
+=cut
+
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT mxdomain_id, domain, unix_user, boxes_path, max_popbox,
+    catchall FROM vhffs_mxdomain WHERE object_id = ?};
+    $obj = $class->SUPER::_fill_object($obj, $sql);
+    if($obj->isa('Vhffs::Services::Mail')) {
+        $obj->{boxes} = fetch_boxes($obj->get_db_object, $obj->{domain});
+        $obj->{forward} = fetch_forwards($obj->get_db_object, $obj->{domain});
+    }
+    return $obj;
+}
+
+=head2 fetch_boxes
+
+    my $boxes = fetch_boxes($dbh, $domain);
+
+Returns an hashref of hashrefs containing all this domain's boxes, indexed on
+local_part.
+
+Internal module use.
+
+=cut
+
+sub fetch_boxes {
+    my ($dbh, $domain) = @_;
+    my $sql = q{SELECT domain, local_part, domain_hash, password_hash,
+    mbox_name, password_hash AS password, nospam, novirus FROM vhffs_boxes
+    WHERE domain = ?};
+    return $dbh->selectall_hashref($sql, 'local_part', undef, $domain);
+}
+
+=head2 fetch_forwards
+
+    my $forwards = fetch_forwards($dbh, $domain);
+
+Returns an hashref of hashrefs containing all this domain's forwards, indexed
+on local_part.
+
+Internal module use.
+
+=cut
+
+sub fetch_forwards {
+    my ($dbh, $domain) = @_;
+    my $sql = q{SELECT domain, local_part, remote_name, password
+        FROM vhffs_forward WHERE domain = ?};
+    return $dbh->selectall_hashref($sql, 'local_part', undef, $domain);
+}
+
 sub _new {
     my ($class, $main, $mxdomain_id, $owner_gid, $domain, $unix_user, $boxes_path, $max_popbox, $catchall, $oid, $owner_uid, $date_creation, $state, $description, $boxes, $forwards) = @_;
     my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, $state, Vhffs::Constants::TYPE_MAIL);
@@ -525,7 +577,8 @@
 
 sub getall
 {
-    my ($vhffs, $state, $name, $group) = @_;
+    my ($vhffs,
+    $state, $name, $group) = @_;
 	
     my $sql;
     my $request;

Modified: trunk/vhffs-api/src/Vhffs/Services/Mailing.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mailing.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Mailing.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -128,14 +128,48 @@
     return undef unless ($sth->execute($domain, $local) > 0);
     my @params = $sth->fetchrow_array;
 
-    $sql = 'SELECT sub_id, member, perm, hash, ml_id, language FROM vhffs_ml_subscribers WHERE ml_id = ?';
-    $sth = $dbh->prepare($sql);
-    $sth->execute($params[0]);
-    my $subs = $sth->fetchall_hashref('member');
-    push @params, $subs;
+    push @params, fetch_subs($dbh, $params[0]);
     return _new Vhffs::Services::Mailing($main, @params);
 }
 
+=head2 fetch_subs
+
+    my $subs = fetch_subs($dbh, $ml_id);
+
+Returns an hashref of hashrefs containing all subscribers indexed on their
+mail addresses.
+
+Internal module use only.
+
+=cut
+
+sub fetch_subs {
+
+    my ($dbh, $ml_id) = @_;
+
+    my $sql = q{SELECT sub_id, member, perm, hash, ml_id, language
+        FROM vhffs_ml_subscribers WHERE ml_id = ?};
+    return $dbh->selectall_hashref($sql, 'member', undef, $ml_id);
+}
+
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>.
+
+=cut
+
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT ml_id, local_part, domain, prefix, admin, open_archive,
+        reply_to, sub_ctrl, post_ctrl, signature FROM vhffs_ml
+        WHERE object_id = ?};
+    $obj = $class->SUPER::_fill_object($obj, $sql);
+    if($obj->isa('Vhffs::Services::Mailing')) {
+        $obj->{subs} = fetch_subs($obj->get_db_object, $obj->{ml_id});
+    }
+    return $obj;
+}
+
 sub _new {
     my ($class, $main, $ml_id, $local_part, $domain, $prefix, $owner_gid, $admin, $open_archive, $reply_to, $sub_ctrl, $post_ctrl, $signature, $oid, $owner_uid, $date_creation, $state, $description, $subs) = @_;
 
@@ -332,11 +366,6 @@
     return $hash;
 }
 
-# No need for delete method, foreign keys do the job
-#sub delete
-#{
-#}
-
 sub get_language_for_sub
 {
     my ($main, $sub) = @_;
@@ -532,8 +561,19 @@
     return getall($vhffs, undef, undef, $group);
 }
 
+=head2 get_label
 
+See C<Vhffs::Object::get_label>.
 
+=cut
+
+sub get_label {
+    my $self = shift;
+    return $self->{local_part}.'@'.$self->{domain};
+}
+
+
+
 sub get_title
 {
     my $self = shift;

Modified: trunk/vhffs-api/src/Vhffs/Services/Mysql.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mysql.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Mysql.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -166,6 +166,17 @@
 	return $self->{'dbname'};
 }
 
+=head2 get_label
+
+See C<Vhffs::Object::get_label>.
+
+=cut
+
+sub get_label {
+    my $self = shift;
+    return $self->{dbname};
+}
+
 sub get_title
 {
 	my $self = shift;
@@ -244,6 +255,19 @@
     return _new Vhffs::Services::Mysql($vhffs, @params);
 }
 
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>
+
+=cut
+
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT mysql_id, dbname, dbuser, dbpass FROM vhffs_mysql
+        WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 sub getall
 {
 	my ($vhffs, $state, $name, $group) = @_;

Modified: trunk/vhffs-api/src/Vhffs/Services/Postgres.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Postgres.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Postgres.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -162,7 +162,7 @@
 	my $self = shift;	
 
     my $sql = 'UPDATE vhffs_pgsql SET dbuser = ?, dbpass = ? WHERE pgsql_id = ?';
-	my $sth = $self->get_db_object()->prepare( $query );
+	my $sth = $self->get_db_object()->prepare( $sql );
 	$sth->execute($self->{dbuser}, $self->{dbpass}, $self->{pgsql_id});
 
 
@@ -187,6 +187,11 @@
 	return $self->{'dbname'};
 }
 
+sub get_label {
+	my $self = shift;
+	return $self->{dbname};
+}
+
 sub get_dbpassword
 {
 	my $self = shift;
@@ -258,6 +263,18 @@
 
 }
 
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>.
+
+=cut
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT pgsql_id, dbname, dbuser, dbpass FROM vhffs_pgsql
+        WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 sub getall
 {
     my ($vhffs, $state, $name, $group) = @_;

Modified: trunk/vhffs-api/src/Vhffs/Services/Repository.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Repository.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Repository.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -148,6 +148,19 @@
     return _new Vhffs::Services::Repository($main, @params);
 }
 
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object
+
+=cut
+
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT repository_id, name, quota, quota_used
+        FROM vhffs_repository WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 sub _new {
     my ($class, $main, $repository_id, $name, $owner_uid, $owner_gid, $quota, $quota_used, $oid, $date_creation, $description, $state) = @_;
 
@@ -209,6 +222,10 @@
 	return $repos;
 }
 
+sub get_label {
+	my $self = shift;
+	return $self->{name};
+}
 
 sub get_title
 {

Modified: trunk/vhffs-api/src/Vhffs/Services/Svn.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Svn.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services/Svn.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -110,6 +110,19 @@
 
 }
 
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>.
+
+=cut
+
+sub fill_object {
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT svn_id, reponame, public, ml_name FROM vhffs_svn
+        WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 sub _new
 {
     my ($class, $main, $svn_id, $reponame, $owner_uid, $owner_gid, $public, $ml_name, $oid, $date_creation, $description, $state) = @_;
@@ -184,6 +197,11 @@
     return $self->{'reponame'};
 }
 
+sub get_label
+{
+    my $self = shift;
+    return $self->{reponame};
+}
 
 sub getall
 {

Added: trunk/vhffs-api/src/Vhffs/Services.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/Services.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -0,0 +1,44 @@
+# Vhffs::Services - Convenience package that includes all services.
+# Copyright (c) vhffs project and its contributors
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in
+#    the documentation and/or other materials provided with the
+#    distribution.
+# 3. Neither the name of vhffs nor the names of its contributors
+#    may be used to endorse or promote products derived from this
+#    software without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+
+package Vhffs::Services;
+
+use Vhffs::Services::Cvs;
+use Vhffs::Services::DNS;
+use Vhffs::Services::Httpd;
+use Vhffs::Services::Mail;
+use Vhffs::Services::Mailing;
+use Vhffs::Services::Mysql;
+use Vhffs::Services::Postgres;
+use Vhffs::Services::Repository;
+use Vhffs::Services::Svn;
+
+1;

Modified: trunk/vhffs-api/src/Vhffs/User.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/User.pm	2007-07-13 08:01:47 UTC (rev 722)
+++ trunk/vhffs-api/src/Vhffs/User.pm	2007-07-13 13:12:22 UTC (rev 723)
@@ -600,6 +600,18 @@
     $self->{'admin'} = $value;
 }
 
+=pod
+
+See C<Vhffs::Object::get_label>.
+
+=cut
+
+sub get_label
+{
+    my $self = shift;
+    return $self->{username};
+}
+
 sub is_admin
 {
 	my $self = shift;
@@ -773,6 +785,21 @@
 
 }
 
+=head2 fill_object
+
+See C<Vhffs::Object::fill_object>.
+
+=cut
+
+sub fill_object {
+# We just add some specific fields
+    my ($class, $obj) = @_;
+    my $sql = q{SELECT uid, gid, username, shell, passwd, homedir, admin,
+        firstname, lastname, address, zipcode, city, country, mail, gpg_key,
+        note, language, theme FROM vhffs_users WHERE object_id = ?};
+    return $class->SUPER::_fill_object($obj, $sql);
+}
+
 1;
 
 __END__


Mail converted by MHonArc 2.6.19+ http://listengine.tuxfamily.org/