| [vhffs-dev] [2024] Reworked err... |
[ Thread Index |
Date Index
| More vhffs.org/vhffs-dev Archives
]
Revision: 2024
Author: gradator
Date: 2012-02-19 16:14:31 +0100 (Sun, 19 Feb 2012)
Log Message:
-----------
Reworked err... all remaining Vhffs::Services::* plus polished previously reworked Services
Modified Paths:
--------------
trunk/vhffs-api/src/Vhffs/Robots/Repository.pm
trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm
trunk/vhffs-api/src/Vhffs/Services/Cron.pm
trunk/vhffs-api/src/Vhffs/Services/Cvs.pm
trunk/vhffs-api/src/Vhffs/Services/DNS.pm
trunk/vhffs-api/src/Vhffs/Services/Git.pm
trunk/vhffs-api/src/Vhffs/Services/Mail.pm
trunk/vhffs-api/src/Vhffs/Services/MailUser.pm
trunk/vhffs-api/src/Vhffs/Services/MailingList.pm
trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm
trunk/vhffs-api/src/Vhffs/Services/Mysql.pm
trunk/vhffs-api/src/Vhffs/Services/Newsletter.pm
trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm
trunk/vhffs-api/src/Vhffs/Services/Repository.pm
trunk/vhffs-api/src/Vhffs/Services/Svn.pm
trunk/vhffs-api/src/Vhffs/Services/Web.pm
trunk/vhffs-listengine/src/listengine.pl
trunk/vhffs-robots/src/web_create.pl
Modified: trunk/vhffs-api/src/Vhffs/Robots/Repository.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Robots/Repository.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Robots/Repository.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -37,6 +37,7 @@
use Vhffs::Services::Repository;
use Vhffs::Constants;
use Vhffs::Functions;
+use Vhffs::Group;
sub create_repository
Modified: trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Bazaar.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -117,8 +117,7 @@
my @params;
my $sql = 'SELECT b.bazaar_id, b.reponame, o.owner_uid, o.owner_gid, b.public, b.ml_name, o.object_id, o.date_creation, o.description, o.state
- FROM vhffs_bazaar b INNER JOIN vhffs_object o ON b.object_id = o.object_id WHERE 1=1';
-
+ FROM vhffs_bazaar b INNER JOIN vhffs_object o ON b.object_id = o.object_id';
if(defined $state) {
$sql .= ' AND o.state = ?';
push(@params, $state);
@@ -127,7 +126,7 @@
$sql .= ' AND b.reponame LIKE ?';
push(@params, '%'.$name.'%');
}
- if(defined($group)) {
+ if(defined $group) {
$sql .= ' AND o.owner_gid = ?';
push(@params, $group->get_gid);
}
Modified: trunk/vhffs-api/src/Vhffs/Services/Cron.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Cron.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Cron.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -144,7 +144,7 @@
my @params;
my $sql = 'SELECT c.cron_id, c.cronpath, c.interval, c.reportmail, c.lastrundate, c.lastrunreturncode, c.nextrundate, c.running, o.owner_uid, o.owner_gid, o.object_id, o.date_creation, o.description, o.state FROM vhffs_cron c
- INNER JOIN vhffs_object o ON c.object_id = o.object_id WHERE 1=1';
+ INNER JOIN vhffs_object o ON c.object_id = o.object_id';
if(defined($state)) {
$sql .= ' AND o.state = ?';
push(@params, $state);
Modified: trunk/vhffs-api/src/Vhffs/Services/Cvs.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Cvs.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Cvs.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -142,7 +142,7 @@
my @params;
my $sql = 'SELECT c.cvs_id, c.cvsroot, o.owner_uid, o.owner_gid, c.public, o.object_id, o.date_creation, o.description, o.state
- FROM vhffs_cvs c INNER JOIN vhffs_object o ON c.object_id = o.object_id WHERE 1=1';
+ FROM vhffs_cvs c INNER JOIN vhffs_object o ON c.object_id = o.object_id';
if(defined $state) {
$sql .= ' AND o.state=?';
Modified: trunk/vhffs-api/src/Vhffs/Services/DNS.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/DNS.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/DNS.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -175,7 +175,7 @@
my $domains = [];
my @params;
my $sql = 'SELECT d.domain
- FROM vhffs_dns d INNER JOIN vhffs_object o ON d.object_id = o.object_id WHERE 1=1';
+ FROM vhffs_dns d INNER JOIN vhffs_object o ON d.object_id = o.object_id';
if(defined $state) {
$sql .= ' AND o.state = ?';
Modified: trunk/vhffs-api/src/Vhffs/Services/Git.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Git.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Git.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -118,7 +118,7 @@
my @params;
my $sql = 'SELECT g.git_id, g.reponame, o.owner_uid, o.owner_gid, g.public, g.ml_name, o.object_id, o.date_creation, o.description, o.state
- FROM vhffs_git g INNER JOIN vhffs_object o ON g.object_id = o.object_id WHERE 1=1';
+ FROM vhffs_git g INNER JOIN vhffs_object o ON g.object_id = o.object_id';
if(defined $state) {
$sql .= ' AND o.state = ?';
@@ -128,7 +128,7 @@
$sql .= ' AND g.reponame LIKE ?';
push(@params, '%'.$name.'%');
}
- if(defined($group)) {
+ if(defined $group) {
$sql .= ' AND o.owner_gid = ?';
push(@params, $group->get_gid);
}
@@ -137,7 +137,7 @@
my $dbh = $vhffs->get_db_object();
my $sth = $dbh->prepare($sql);
- $sth->execute(@params) or die($sql) ; #return undef;
+ $sth->execute(@params) or return undef;
while(my $s = $sth->fetchrow_arrayref()) {
push(@$git, _new Vhffs::Services::Git($vhffs, @$s));
Modified: trunk/vhffs-api/src/Vhffs/Services/Mail.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mail.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Mail.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
@@ -52,56 +52,209 @@
use base qw(Vhffs::Object);
use DBI;
+use Vhffs::Functions;
use Vhffs::Services::MailingList;
+#Following function is needed by courier to fetch accounts
+sub crypt_pwd {
+ my $clear = shift;
+ my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
+ return crypt( $clear , $salt );
+}
+
+=pod address_exists
+
+ print ("Adress $local_part\@$domain already exists as a box or forward\n")
+ if(Vhffs::Services::Mail::address_exists($vhffs, $local_part, $domain));
+
+Return true if a box or a forward C<$local_part>@C<$domain> already exists.
+It does B<not> check for mailing lists (use Vhffs::Services::MailingList::address_exists).
+
+=cut
+sub address_exists($$$) {
+ my ($vhffs, $local_part, $domain) = @_;
+
+ my $sql = 'SELECT SUM(c) FROM (
+ (SELECT COUNT(*) AS c FROM vhffs_boxes b WHERE b.domain = ? AND b.local_part = ?)
+ UNION
+ (SELECT COUNT(*) AS c FROM vhffs_forward f WHERE f.domain = ? AND f.local_part = ?)
+ )
+ AS counts';
+
+ my $dbh = $vhffs->get_db_object();
+ my $res = $dbh->selectrow_array($sql, {}, $domain, $local_part, $domain, $local_part);
+ return (defined $res and $res > 0);
+}
+
+sub _new {
+ my ($class, $main, $mxdomain_id, $owner_gid, $domain, $boxes_path, $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);
+ return undef unless defined($self);
+
+ $self->{mxdomain_id} = $mxdomain_id;
+ $self->{domain} = $domain;
+ $self->{boxes_path} = $boxes_path;
+ $self->{catchall} = $catchall;
+ $self->{boxes} = $boxes;
+ $self->{forward} = $forwards;
+
+ return $self;
+}
+
=pod
=head2 create
- my $mail = Vhffs::Services::Mail::create($main, $domain, $description, $user, $group);
+ my $mail = Vhffs::Services::Mail::create($main, $domain, $description, $user, $group);
Create a new domain mail in database and return corresponding object.
=cut
-
sub create {
- my ($main, $domain, $description, $user, $group) = @_;
- return undef unless(defined($user) && defined($group));
- return undef unless(Vhffs::Functions::check_domain_name($domain));
+ my ($main, $domain, $description, $user, $group) = @_;
+ return undef unless(defined($user) && defined($group));
+ return undef unless(Vhffs::Functions::check_domain_name($domain));
- my $mail;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
+ my $mail;
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
- eval {
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_MAIL);
+ eval {
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_MAIL);
- die('Unable to create parent object') unless(defined $parent);
+ die('Unable to create parent object') unless(defined $parent);
- my $sql = 'INSERT INTO vhffs_mxdomain(domain, boxes_path, catchall, object_id) VALUES(?, ?, \'\', ?)';
- my $domain_hash = substr( $domain, 0, 1 ).'/'.substr( $domain, 1, 1 ).'/'.$domain ;
- my $sth = $dbh->prepare($sql);
- $sth->execute($domain, $domain_hash, $parent->get_oid);
+ my $sql = 'INSERT INTO vhffs_mxdomain(domain, boxes_path, catchall, object_id) VALUES(?, ?, \'\', ?)';
+ my $domain_hash = substr( $domain, 0, 1 ).'/'.substr( $domain, 1, 1 ).'/'.$domain ;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($domain, $domain_hash, $parent->get_oid);
- $dbh->commit;
- $mail = get_by_mxdomain($main, $domain);
- };
+ $dbh->commit;
+ $mail = get_by_mxdomain($main, $domain);
+ };
- if($@) {
- warn "Unable to create mail domain $domain: $@\n";
- $dbh->rollback;
- }
+ if($@) {
+ warn "Unable to create mail domain $domain: $@\n";
+ $dbh->rollback;
+ }
- return $mail;
+ return $mail;
}
-# Commit all changes of the current instance in the database
-sub commit
-{
- use Vhffs::Functions;
+=head2 fill_object
+See C<Vhffs::Object::fill_object>.
+
+=cut
+sub fill_object {
+ my ($class, $obj) = @_;
+ my $sql = q{SELECT mxdomain_id, domain, boxes_path,
+ 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;
+}
+
+sub getall {
+ my ($vhffs, $state, $name, $group) = @_;
+
+ my $mail = [];
+ my @params;
+
+ my $sql = 'SELECT m.domain
+ FROM vhffs_mxdomain m INNER JOIN vhffs_object o ON m.object_id = o.object_id';
+ if(defined $state) {
+ $sql .= ' AND o.state=?';
+ push(@params, $state);
+ }
+ if(defined $name) {
+ $sql .= ' AND m.domain LIKE ?';
+ push(@params, '%'.$name.'%');
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid= ?';
+ push(@params, $group->get_gid);
+ }
+ $sql .= ' ORDER BY m.domain';
+
+ my $dbh = $vhffs->get_db_object();
+
+ my $sth = $dbh->prepare( $sql );
+ $sth->execute(@params) or return undef;
+
+ while( my $s = $sth->fetchrow_hashref() ) {
+ push( @$mail, get_by_mxdomain( $vhffs, $s->{domain} ) );
+ }
+ return $mail;
+}
+
+=pod
+
+=head2 get_by_mxdomain
+
+ my $mail = Vhffs::Services::get_by_mxdomain($main, $domain);
+ die("Mail domain $domain not found\n") unless(defined $mail);
+
+Fetches the mail services whose domainname is $domain.
+
+=cut
+sub get_by_mxdomain {
+ my ($main, $domain) = @_;
+
+ my $sql = 'SELECT m.mxdomain_id, o.owner_gid, m.domain, m.boxes_path, m.catchall, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_mxdomain m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE domain = ?';
+ my $dbh = $main->get_db_object();
+ my @params;
+ return undef unless(@params = $dbh->selectrow_array($sql, undef, $domain));
+
+ # We now need the boxes and forwards
+ my $boxes = fetch_boxes($dbh, $domain);
+ my $forwards = fetch_forwards($dbh, $domain);
+
+ return _new Vhffs::Services::Mail($main, @params, $boxes, $forwards);
+}
+
+=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,
+ mbox_name, nospam, novirus, allowpop, allowimap, state FROM vhffs_boxes
+ WHERE domain = ? ORDER BY local_part};
+ 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 = ? ORDER BY local_part};
+ return $dbh->selectall_hashref($sql, 'local_part', undef, $domain);
+}
+
+# Commit all changes of the current instance in the database
+sub commit {
my $self = shift;
my( $request , $result , $rows , $query , $name , $password);
@@ -117,154 +270,138 @@
return 1;
}
-
-sub get_dir
-{
+sub get_dir {
my $self = shift;
return undef unless defined $self;
return( $self->{'main'}->get_config->get_datadir . '/mail/boxes/' . $self->{'boxes_path'} );
}
-
-sub change_forward
-{
+sub change_forward {
my $self = shift;
my $local_part = shift;
my $destination = shift;
- return -1 unless( defined($self->{forward}{$local_part}) && defined($local_part) && defined($destination) && Vhffs::Functions::valid_mail( $destination ) );
+ return -1 unless( defined($self->{forward}{$local_part}) && defined($local_part) && defined($destination) && Vhffs::Functions::valid_mail( $destination ) );
- my $sql = 'UPDATE vhffs_forward SET remote_name = ? WHERE local_part = ? AND domain = ?';
- my $dbh = $self->{db};
- my $sth = $dbh->prepare($sql);
- $sth->execute($destination, $local_part, $self->{domain}) or return -1;
+ my $sql = 'UPDATE vhffs_forward SET remote_name = ? WHERE local_part = ? AND domain = ?';
+ my $dbh = $self->{db};
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($destination, $local_part, $self->{domain}) or return -1;
$self->{'forward'}{$local_part}{'remote_name'} = $destination;
return 1;
}
-sub change_box_password
-{
+sub change_box_password {
my $self = shift;
my $local_part = shift;
my $password = shift;
return -1 unless defined $self->{'boxes'}{$local_part};
- $password = crypt_pwd( $password );
+ $password = crypt_pwd( $password );
$self->{'boxes'}{$local_part}{'password'} = $password;
- my $sql = 'UPDATE vhffs_boxes SET password = ? WHERE local_part = ? AND domain = ?';
- my $dbh = $self->{db};
- my $sth = $dbh->prepare($sql);
- $sth->execute($password, $local_part, $self->{domain}) or return -1;
+ my $sql = 'UPDATE vhffs_boxes SET password = ? WHERE local_part = ? AND domain = ?';
+ my $dbh = $self->{db};
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($password, $local_part, $self->{domain}) or return -1;
return 1;
}
-# The change_spam_status function change the status of a box
+# The change_spam_status function change the status of a box
# on the mail domain given in parmeter
# If the spam removal was enable, it will be disable at next commit() on object
-sub change_spam_status
-{
+sub change_spam_status {
my $self = shift;
my $local_part = shift;
return -1 if( ! defined $self->{'boxes'}{$local_part} );
- my $nospam = $self->{boxes}{$local_part}{nospam};
- if( defined( $nospam ) ) {
- $nospam = ( $nospam + 1 ) % 2;
- } else {
- $nospam = 1;
- }
- $self->{boxes}{$local_part}{nospam} = $nospam;
+ my $nospam = $self->{boxes}{$local_part}{nospam};
+ if( defined( $nospam ) ) {
+ $nospam = ( $nospam + 1 ) % 2;
+ } else {
+ $nospam = 1;
+ }
+ $self->{boxes}{$local_part}{nospam} = $nospam;
- my $sql = 'UPDATE vhffs_boxes SET nospam = ? WHERE domain = ? AND local_part = ?';
- my $dbh = $self->{db};
- my $sth = $dbh->prepare($sql);
- $sth->execute($nospam, $self->{domain}, $local_part) or return -1;
+ my $sql = 'UPDATE vhffs_boxes SET nospam = ? WHERE domain = ? AND local_part = ?';
+ my $dbh = $self->{db};
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($nospam, $self->{domain}, $local_part) or return -1;
return 1;
}
=head2 set_spam_status
- $mail->set_spam_status($boxname, $status);
+ $mail->set_spam_status($boxname, $status);
Sets the spam protection status to C<$status> (0 or 1).
=cut
-
sub set_spam_status {
- my ($self, $boxname, $status) = @_;
-
- return -1 unless(defined $self->{boxes}{$boxname});
+ my ($self, $boxname, $status) = @_;
+
+ return -1 unless(defined $self->{boxes}{$boxname});
- $self->{boxes}{$boxname}{nospam} = $status;
- my $sql = 'UPDATE vhffs_boxes SET nospam = ? WHERE domain = ? AND local_part = ?';
- my $dbh = $self->get_db_object();
- return -2 unless( $dbh->do($sql, undef, $status, $self->{domain}, $boxname) );
- return 1;
+ $self->{boxes}{$boxname}{nospam} = $status;
+ my $sql = 'UPDATE vhffs_boxes SET nospam = ? WHERE domain = ? AND local_part = ?';
+ my $dbh = $self->get_db_object();
+ return -2 unless( $dbh->do($sql, undef, $status, $self->{domain}, $boxname) );
+ return 1;
}
-
=head2 set_virus_status
- $mail->set_virus_status($boxname, $status);
+ $mail->set_virus_status($boxname, $status);
Sets the virus protection status to C<$status> (0 or 1).
=cut
-
sub set_virus_status {
- my ($self, $boxname, $status) = @_;
-
- return -1 unless(defined $self->{boxes}{$boxname});
+ my ($self, $boxname, $status) = @_;
+ return -1 unless defined $self->{boxes}{$boxname};
- $self->{boxes}{$boxname}{novirus} = $status;
- my $sql = 'UPDATE vhffs_boxes SET novirus = ? WHERE domain = ? AND local_part = ?';
- my $dbh = $self->get_db_object();
- return -2 unless( $dbh->do($sql, undef, $status, $self->{domain}, $boxname) );
- return 1;
+ $self->{boxes}{$boxname}{novirus} = $status;
+ my $sql = 'UPDATE vhffs_boxes SET novirus = ? WHERE domain = ? AND local_part = ?';
+ my $dbh = $self->get_db_object();
+ return -2 unless( $dbh->do($sql, undef, $status, $self->{domain}, $boxname) );
+ return 1;
}
-
#work as change_spam_status
-sub change_virus_status
-{
+sub change_virus_status {
my $self = shift;
my $local_part = shift;
+ return -1 unless defined $self->{'boxes'}{$local_part};
- return -1 if( ! defined $self->{'boxes'}{$local_part} );
+ my $novirus = $self->{boxes}{$local_part}{novirus};
+ if(defined $novirus) {
+ $novirus = ($novirus + 1) % 2;
+ } else {
+ $novirus = 1;
+ }
- my $novirus = $self->{boxes}{$local_part}{novirus};
- if(defined $novirus) {
- $novirus = ($novirus + 1) % 2;
- } else {
- $novirus = 1;
- }
-
$self->{'boxes'}{$local_part}{'novirus'} = $novirus;
- my $sql = 'UPDATE vhffs_boxes SET novirus = ? WHERE domain = ? AND local_part = ?';
- my $dbh = $self->{db};
- my $sth = $dbh->prepare($sql);
- $sth->execute($novirus, $self->{domain}, $local_part) or return -1;
+ my $sql = 'UPDATE vhffs_boxes SET novirus = ? WHERE domain = ? AND local_part = ?';
+ my $dbh = $self->{db};
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($novirus, $self->{domain}, $local_part) or return -1;
return 1;
}
-
-sub set_box_allowpop
-{
+sub set_box_allowpop {
my $self = shift;
my $local_part = shift;
my $allow = shift;
-
return -1 unless defined $self->{'boxes'}{$local_part};
$self->{'boxes'}{$local_part}{'allowpop'} = $allow;
@@ -277,23 +414,17 @@
return 1;
}
-
-sub get_box_allowpop
-{
+sub get_box_allowpop {
my $self = shift;
my $local_part = shift;
-
return undef unless defined $self->{'boxes'}{$local_part};
return $self->{'boxes'}{$local_part}{'allowpop'};
}
-
-sub set_box_allowimap
-{
+sub set_box_allowimap {
my $self = shift;
my $local_part = shift;
my $allow = shift;
-
return -1 unless defined $self->{'boxes'}{$local_part};
$self->{'boxes'}{$local_part}{'allowimap'} = $allow;
@@ -306,23 +437,17 @@
return 1;
}
-
-sub get_box_allowimap
-{
+sub get_box_allowimap {
my $self = shift;
my $local_part = shift;
-
return undef unless defined $self->{'boxes'}{$local_part};
return $self->{'boxes'}{$local_part}{'allowimap'};
}
-
-sub set_box_status
-{
+sub set_box_status {
my $self = shift;
my $local_part = shift;
my $state = shift;
-
return -1 unless defined $self->{'boxes'}{$local_part};
$self->{'boxes'}{$local_part}{'state'} = $state;
@@ -335,40 +460,31 @@
return 1;
}
-
-sub get_box_status
-{
+sub get_box_status {
my $self = shift;
my $local_part = shift;
-
return undef unless defined $self->{'boxes'}{$local_part};
return $self->{'boxes'}{$local_part}{'state'};
}
-
-sub get_box_dir
-{
+sub get_box_dir {
my $self = shift;
my $local_part = shift;
+ return undef unless defined $self and defined $local_part and defined $self->{'boxes'}{$local_part};
- return undef unless( defined $self && defined $local_part && defined $self->{'boxes'}{$local_part} );
-
return( $self->{'main'}->get_config->get_datadir . '/mail/boxes/' . $self->{'boxes_path'} . '/' . $self->{'boxes'}{$local_part}{'mbox_name'} );
}
-
=pod
=head2 addforward
- die("Unable to add forward $local_part\n") unless($mail->addforward($local_part, $remote_address) > 0);
+ die("Unable to add forward $local_part\n") unless($mail->addforward($local_part, $remote_address) > 0);
Add a forward from $local_part@$mail->get_domain to $remote_address.
=cut
-
-sub addforward
-{
+sub addforward {
my $self = shift;
my $name = shift;
my $remote = shift;
@@ -378,15 +494,15 @@
|| ( defined $self->{'boxes'}{$name} && $self->{'boxes'}{$name}{'state'} != Vhffs::Constants::TO_DELETE )
|| Vhffs::Services::MailingList::address_exists($self->get_main, $name, $self->{domain}) );
- my $sql = 'INSERT INTO vhffs_forward(domain, local_part, remote_name, password) VALUES(?, ?, ?, \'x\')';
- my $dbh = $self->{db};
- my $sth = $dbh->prepare($sql);
- $sth->execute($self->{domain}, $name, $remote) or return -3;
+ my $sql = 'INSERT INTO vhffs_forward(domain, local_part, remote_name, password) VALUES(?, ?, ?, \'x\')';
+ my $dbh = $self->{db};
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($self->{domain}, $name, $remote) or return -3;
$self->{'forward'}{$name}{'local_part'} = $name;
$self->{'forward'}{$name}{'domain'} = $self->{'domain'};
$self->{'forward'}{$name}{'remote_name'} = $remote;
- $self->{forward}{$name}{password} = 'x';
+ $self->{forward}{$name}{password} = 'x';
return 1;
}
@@ -395,45 +511,42 @@
=head2 addbox
- die("Unable to create box\n") unless($mail->addbox($local_part, $password));
+ die("Unable to create box\n") unless($mail->addbox($local_part, $password));
Add a new mailbox to the mail domain.
=cut
-
-sub addbox
-{
+sub addbox {
my $self = shift;
my $name = shift;
my $password = shift;
- return -1 unless( defined($password) && defined($name) && $name =~ /^[a-z0-9\_\-\.]+$/ );
- return -2 if( ( defined ( $self->{'boxes'}{$name} ) ) || ( defined( $self->{'forward'}{$name} ) )
- || Vhffs::Services::MailingList::address_exists($self->get_main, $name, $self->{domain}) );
+ return -1 unless( defined($password) && defined($name) && $name =~ /^[a-z0-9\_\-\.]+$/ );
+ return -2 if( ( defined ( $self->{'boxes'}{$name} ) ) || ( defined( $self->{'forward'}{$name} ) )
+ || Vhffs::Services::MailingList::address_exists($self->get_main, $name, $self->{domain}) );
- $password = crypt_pwd( $password );
- my $domainhash = $self->{boxes_path};
- my $userhash = substr( $name, 0, 1 ).'/'.$name;
+ $password = crypt_pwd( $password );
+ my $domainhash = $self->{boxes_path};
+ my $userhash = substr( $name, 0, 1 ).'/'.$name;
$self->{'boxes'}{$name}{'local_part'} = $name;
$self->{'boxes'}{$name}{'password'} = $password;
$self->{'boxes'}{$name}{'domain'} = $self->{'domain'};
- $self->{boxes}{$name}{domain_hash} = $domainhash;
- $self->{boxes}{$name}{password} = $password;
- $self->{boxes}{$name}{novirus} = 0;
- $self->{boxes}{$name}{nospam} = 0;
- $self->{boxes}{$name}{mbox_name} = $userhash;
- $self->{boxes}{$name}{state} = Vhffs::Constants::WAITING_FOR_CREATION;
+ $self->{boxes}{$name}{domain_hash} = $domainhash;
+ $self->{boxes}{$name}{password} = $password;
+ $self->{boxes}{$name}{novirus} = 0;
+ $self->{boxes}{$name}{nospam} = 0;
+ $self->{boxes}{$name}{mbox_name} = $userhash;
+ $self->{boxes}{$name}{state} = Vhffs::Constants::WAITING_FOR_CREATION;
- my $sql = 'INSERT INTO vhffs_boxes(domain, local_part, domain_hash, password, mbox_name, nospam, novirus, allowpop, allowimap, state) VALUES(?, ?, ?, ?, ?, FALSE, FALSE, TRUE, TRUE, ?)';
- my $dbh = $self->{db};
- my $sth = $dbh->prepare($sql);
- $sth->execute($self->{domain}, $name, $domainhash, $password, $userhash, Vhffs::Constants::WAITING_FOR_CREATION) or return -3;
+ my $sql = 'INSERT INTO vhffs_boxes(domain, local_part, domain_hash, password, mbox_name, nospam, novirus, allowpop, allowimap, state) VALUES(?, ?, ?, ?, ?, FALSE, FALSE, TRUE, TRUE, ?)';
+ my $dbh = $self->{db};
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($self->{domain}, $name, $domainhash, $password, $userhash, Vhffs::Constants::WAITING_FOR_CREATION) or return -3;
return 1;
}
-sub delbox
-{
+sub delbox {
my $self = shift;
my $name = shift;
@@ -441,94 +554,72 @@
delete $self->{boxes}{$name};
- my $dbh = $self->get_db_object;
- my $sql = 'DELETE FROM vhffs_boxes WHERE local_part = ? AND domain = ?';
- $dbh->do($sql, undef, $name, $self->{domain});
- $sql = 'UPDATE vhffs_mxdomain SET catchall = \'\' WHERE catchall = ?';
- $dbh->do($sql, undef, $name.'@'.$self->{domain});
+ my $dbh = $self->get_db_object;
+ my $sql = 'DELETE FROM vhffs_boxes WHERE local_part = ? AND domain = ?';
+ $dbh->do($sql, undef, $name, $self->{domain});
+ $sql = 'UPDATE vhffs_mxdomain SET catchall = \'\' WHERE catchall = ?';
+ $dbh->do($sql, undef, $name.'@'.$self->{domain});
}
-
-sub delforward
-{
+sub delforward {
my $self = shift;
my $name = shift;
return -1 unless( defined $name && ( $name =~ /^[a-z0-9\_\-\.]+$/ ) );
delete $self->{forward}{$name};
- my $dbh = $self->get_db_object;
- my $sql = 'DELETE FROM vhffs_forward WHERE local_part = ? AND domain = ?';
- $dbh->do($sql, undef, $name, $self->{domain});
- $sql = 'UPDATE vhffs_mxdomain SET catchall = \'\' WHERE catchall = ?';
- $dbh->do($sql, undef, $name.'@'.$self->{domain});
+ my $dbh = $self->get_db_object;
+ my $sql = 'DELETE FROM vhffs_forward WHERE local_part = ? AND domain = ?';
+ $dbh->do($sql, undef, $name, $self->{domain});
+ $sql = 'UPDATE vhffs_mxdomain SET catchall = \'\' WHERE catchall = ?';
+ $dbh->do($sql, undef, $name.'@'.$self->{domain});
}
# Returns a hashref with all forwards
# Ths key of this hash is the local part for the forward
-sub get_forwards
-{
+sub get_forwards {
my $self = shift;
return $self->{'forward'};
}
-sub exists
-{
+sub exists {
my $self = shift;
my $name = shift;
-
- return 1 if( ( $self->exists_forward( $name ) ==1 ) || ( $self->exists_box( $name ) ==1 ) );
- return 0;
+ return( $self->exists_forward($name) or $self->exists_box($name) );
}
-sub exists_forward
-{
+sub exists_forward {
my $self = shift;
my $name = shift;
- return -1 if( ! ( $name =~ /^[a-z0-9\_\-\.]+$/ ) );
- my $request = $self->{'db'}->prepare("SELECT * FROM vhffs_forward where domain='".$self->{'domain'}."' AND local_part='".$name."'") or return -1;
- return 1 if( $request->execute() > 0 );
- return 0;
+ return undef unless $name =~ /^[a-z0-9\_\-\.]+$/;
+ my $request = $self->{'db'}->prepare('SELECT COUNT(*) FROM vhffs_forward where domain=? AND local_part=?') or return undef;
+ $request->execute( $self->{'domain'}, $name ) or return undef;
+ my ( $rows ) = $request->fetchrow();
+ return $rows;
}
-sub exists_box
-{
+sub exists_box {
my $self = shift;
my $name = shift;
- return -1 if( ! ( $name =~ /^[a-z0-9\_\-\.]+$/ ) );
- my $request = $self->{'db'}->prepare("SELECT * FROM vhffs_boxes where domain='".$self->{'domain'}."' AND local_part='".$name."'") or return -1;
- return 1 if( $request->execute() > 0 );
- return 0;
+ return undef unless $name =~ /^[a-z0-9\_\-\.]+$/;
+ my $request = $self->{'db'}->prepare('SELECT COUNT(*) FROM vhffs_boxes where domain=? AND local_part=?') or return undef;
+ $request->execute( $self->{'domain'}, $name ) or return undef;
+ my ( $rows ) = $request->fetchrow();
+ return $rows;
}
-
-sub nb_boxes
-{
+sub nb_boxes {
my $self = shift;
return scalar( keys( %{$self->{'boxes'}} ) );
}
-
-sub nb_forwards
-{
+sub nb_forwards {
my $self = shift;
return scalar( keys( %{$self->{'forward'}} ) );
}
-
-#Following function is needed by courier to fetch accounts
-
-sub crypt_pwd
-{
- my $clear = shift;
- my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64];
- return crypt( $clear , $salt );
-}
-
-
# return 1 if the password is good, else return something 0
-sub check_box_password
-{
+sub check_box_password {
my $self = shift;
my $local_part = shift;
my $clearpw = shift;
@@ -536,8 +627,7 @@
return 0 unless defined $self->{'boxes'}{$local_part};
my $dbpass = $self->{'boxes'}{$local_part}{'password'};
- return 1 if( $dbpass eq crypt( $clearpw, $dbpass ) );
- return 0;
+ return ( $dbpass eq crypt( $clearpw, $dbpass ) );
}
# Returns an hashref with all boxes
@@ -549,240 +639,52 @@
}
sub get_label {
- my $self = shift;
- return $self->{domain};
+ my $self = shift;
+ return $self->{domain};
}
-sub get_domain
-{
+sub get_domain {
my $self = shift;
return $self->{'domain'};
}
-
-
###########################
# ospam function only use when the mail domain
# if fetched
# It can explain if a box use antispam or not
# for example $mail->use_nospam( 'myaccount' );
-# returns -1 if error
+# returns undef if error
# 0 if nospam is used
# 1 if spam is used
-sub use_nospam
-{
+sub use_nospam {
my $self = shift;
my $box = shift;
-
- return -1 if( ! defined( $self->{'boxes'}->{$box} ) );
- return 1 if( $self->{'boxes'}->{$box}{'nospam'} == 1 );
- return 0;
+ return undef unless defined $self->{'boxes'}->{$box};
+ return $self->{'boxes'}->{$box}{'nospam'};
}
-sub use_novirus
-{
+sub use_novirus {
my $self = shift;
my $box = shift;
-
- return -1 if( ! defined( $self->{'boxes'}->{$box} ) );
- return 1 if( $self->{'boxes'}->{$box}{'novirus'} == 1 );
- return 0;
+ return undef unless defined $self->{'boxes'}->{$box};
+ return $self->{'boxes'}->{$box}{'novirus'};
}
-
-
-sub get_boxespath
-{
+sub get_boxespath {
my $self = shift;
return $self->{'boxes_path'};
}
-sub get_catchall
-{
+sub get_catchall {
my $self = shift;
-
- if( defined $self->{'catchall'} )
- {
- return $self->{'catchall'};
- }
- else
- {
- return "";
- }
+ return $self->{'catchall'};
}
-sub set_catchall
-{
+sub set_catchall {
my( $self , $value ) = @_;
- use Vhffs::Functions;
- if( $value eq '' || Vhffs::Functions::valid_mail( $value ) )
- {
- $self->{'catchall'} = $value;
- return 1;
- }
- return -1;
+ return -1 unless ( $value eq '' or Vhffs::Functions::valid_mail( $value ) );
+ $self->{'catchall'} = $value;
+ return 1;
}
-=pod
-
-=head2 get_by_mxdomain
-
- my $mail = Vhffs::Services::get_by_mxdomain($main, $domain);
- die("Mail domain $domain not found\n") unless(defined $mail);
-
-Fetches the mail services whose domainname is $domain.
-
-=cut
-
-sub get_by_mxdomain {
- my ($main, $domain) = @_;
-
- my $sql = 'SELECT m.mxdomain_id, o.owner_gid, m.domain, m.boxes_path, m.catchall, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_mxdomain m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE domain = ?';
- my $dbh = $main->get_db_object();
- my @params;
- return undef unless(@params = $dbh->selectrow_array($sql, undef, $domain));
-
- # We now need the boxes and forwards
- my $boxes = fetch_boxes($dbh, $domain);
- my $forwards = fetch_forwards($dbh, $domain);
-
-
- 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, boxes_path,
- 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,
- mbox_name, nospam, novirus, allowpop, allowimap, state FROM vhffs_boxes
- WHERE domain = ? ORDER BY local_part};
- 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 = ? ORDER BY local_part};
- return $dbh->selectall_hashref($sql, 'local_part', undef, $domain);
-}
-
-sub _new {
- my ($class, $main, $mxdomain_id, $owner_gid, $domain, $boxes_path, $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);
- return undef unless defined($self);
-
- $self->{mxdomain_id} = $mxdomain_id;
- $self->{domain} = $domain;
- $self->{boxes_path} = $boxes_path;
- $self->{catchall} = $catchall;
- $self->{boxes} = $boxes;
- $self->{forward} = $forwards;
-
- return $self;
-}
-
-sub getall
-{
- my ($vhffs,
- $state, $name, $group) = @_;
-
- my $sql;
- my $request;
- my @params;
-
- my $objs = [];
- my $result;
- my $tmp;
-
- $sql = 'SELECT m.domain FROM vhffs_mxdomain m, vhffs_object o WHERE m.object_id = o.object_id';
- if(defined $state) {
- $sql .= ' AND o.state=?';
- push(@params, $state);
- }
- if(defined $name) {
- $sql .= ' AND m.domain LIKE ?';
- push(@params, '%'.$name.'%');
- }
- if(defined $group) {
- $sql .= ' AND o.owner_gid= ?';
- push(@params, $group->get_gid);
- }
- $request = $vhffs->{'db'}->prepare( $sql );
- my $rows = $request->execute(@params);
-
- return undef if( !$rows );
-
- while( $result = $request->fetchrow_hashref() )
- {
- push( @$objs, Vhffs::Services::Mail::get_by_mxdomain( $vhffs, $result->{domain} ) );
- }
- return $objs;
-}
-
-
-=pod address_exists
-
- print ("Adress $local_part\@$domain already exists as a box or forward\n")
- if(Vhffs::Services::Mail::address_exists($vhffs, $local_part, $domain));
-
-Return true if a box or a forward C<$local_part>@C<$domain> already exists.
-It does B<not> check for mailing lists (use Vhffs::Services::MailingList::address_exists).
-
-=cut
-
-sub address_exists($$$) {
- my ($vhffs, $local_part, $domain) = @_;
-
- my $sql = <<EOQ;
-SELECT SUM(c) FROM (
- (SELECT COUNT(*) AS c FROM vhffs_boxes b WHERE b.domain = ? AND b.local_part = ?)
- UNION
- (SELECT COUNT(*) AS c FROM vhffs_forward f WHERE f.domain = ? AND f.local_part = ?))
- AS counts
-EOQ
- my $dbh = $vhffs->get_db_object();
- my $res = $dbh->selectrow_array($sql, {}, $domain, $local_part, $domain, $local_part);
- return (defined($res) && $res > 0);
-}
-
1;
Modified: trunk/vhffs-api/src/Vhffs/Services/MailUser.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/MailUser.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/MailUser.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
Modified: trunk/vhffs-api/src/Vhffs/Services/MailingList.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/MailingList.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/MailingList.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
@@ -55,87 +55,157 @@
use base qw(Vhffs::Object);
use DBI;
+sub _new {
+ my ($class, $main, $ml_id, $local_part, $domain, $prefix, $owner_gid, $open_archive, $reply_to, $sub_ctrl, $post_ctrl, $signature, $oid, $owner_uid, $date_creation, $state, $description, $subs) = @_;
+
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_ML);
+ return undef unless defined($self);
+
+ $self->{ml_id} = $ml_id;
+ $self->{local_part} = $local_part;
+ $self->{domain} = $domain,
+ $self->{prefix} = $prefix;
+ $self->{open_archive} = $open_archive;
+ $self->{reply_to} = $reply_to;
+ $self->{sub_ctrl} = $sub_ctrl;
+ $self->{post_ctrl} = $post_ctrl;
+ $self->{signature} = $signature;
+ $self->{subs} = $subs;
+
+ return $self;
+}
+
=pod
=head2 create
- my $ml = Vhffs::Services::MailingList::create($local, $domain, $description, $user, $group);
- die('Unable to create list') unless defined $ml;
+ my $ml = Vhffs::Services::MailingList::create($local, $domain, $description, $user, $group);
+ die('Unable to create list') unless defined $ml;
Creates a new mailing list in database and returns the corresponding fully functional object.
Returns undef if an error occurs (box, forward or mailing list with the same address already
exists, domain not found, ...).
=cut
-sub create
-{
- my ($main, $local, $domain, $description, $user, $group) = @_;
-
- return undef unless(defined $user && defined $group);
- return undef unless($local =~ /^[a-z0-9\_\-]+$/);
- return undef unless(Vhffs::Functions::check_domain_name($domain));
- return undef if(Vhffs::Services::Mail::address_exists($main, $local, $domain));
+sub create {
+ my ($main, $local, $domain, $description, $user, $group) = @_;
+
+ return undef unless(defined $user && defined $group);
+ return undef unless($local =~ /^[a-z0-9\_\-]+$/);
+ return undef unless(Vhffs::Functions::check_domain_name($domain));
+ return undef if(Vhffs::Services::Mail::address_exists($main, $local, $domain));
- my $ml;
+ my $ml;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
- eval {
- # Group must be the mail domain owner or use default mail domain.
- my $sql = 'SELECT mxdomain_id FROM vhffs_mxdomain m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE m.domain = ? AND o.owner_gid = ?';
- die('Mail domain not found') unless($domain eq $main->get_config()->get_service("mailinglist")->{'default_domain'} ||
- $dbh->do($sql, undef, $domain, $group->get_gid) > 0);
+ eval {
+ # Group must be the mail domain owner or use default mail domain.
+ my $sql = 'SELECT mxdomain_id FROM vhffs_mxdomain m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE m.domain = ? AND o.owner_gid = ?';
+ die('Mail domain not found') unless($domain eq $main->get_config()->get_service('mailinglist')->{'default_domain'} ||
+ $dbh->do($sql, undef, $domain, $group->get_gid) > 0);
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_ML);
- die('Unable to create parent object') unless(defined $parent);
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_ML);
+ die('Unable to create parent object') unless(defined $parent);
# open sub, post members only
- $sql = 'INSERT INTO vhffs_ml(local_part, domain, prefix, object_id, open_archive, reply_to, sub_ctrl, post_ctrl) VALUES(?, ?, ?, ?, FALSE, TRUE, ?, ? )';
- my $sth = $dbh->prepare($sql);
- $sth->execute($local, $domain, $local, $parent->get_oid, Vhffs::Constants::ML_SUBSCRIBE_NO_APPROVAL_REQUIRED, Vhffs::Constants::ML_POSTING_MEMBERS_ONLY);
- $dbh->commit;
- $ml = get_by_mladdress($main, $local, $domain);
- };
+ $sql = 'INSERT INTO vhffs_ml(local_part, domain, prefix, object_id, open_archive, reply_to, sub_ctrl, post_ctrl) VALUES(?, ?, ?, ?, FALSE, TRUE, ?, ? )';
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($local, $domain, $local, $parent->get_oid, Vhffs::Constants::ML_SUBSCRIBE_NO_APPROVAL_REQUIRED, Vhffs::Constants::ML_POSTING_MEMBERS_ONLY);
+ $dbh->commit;
+ $ml = get_by_mladdress($main, $local, $domain);
+ };
- if($@) {
- warn "Unable to create mailing list $local\@$domain: $@\n";
- $dbh->rollback;
- }
+ if($@) {
+ warn 'Unable to create mailing list '.$local.'@'.$domain.': '.$@."\n";
+ $dbh->rollback;
+ }
- return $ml;
+ return $ml;
+}
+=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, 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::MailingList')) {
+ $obj->{subs} = fetch_subs($obj->get_db_object, $obj->{ml_id});
+ }
+ return $obj;
}
+sub getall {
+ my ($vhffs, $state, $name, $group, $domain) = @_;
+
+ my $mls = [];
+ my @params;
+
+ my $sql = 'SELECT ml.local_part, ml.domain
+ FROM vhffs_ml ml INNER JOIN vhffs_object o ON ml.object_id = o.object_id';
+ if(defined $state) {
+ $sql .= ' AND o.state = ?';
+ push @params, $state;
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid = ?';
+ push @params, $group->get_gid;
+ }
+ if(defined $name) {
+ $sql .= ' AND ( local_part LIKE ? OR domain LIKE ?)';
+ push @params, '%'.$name.'%', '%'.$name.'%';
+ }
+ if(defined $domain) {
+ $sql .= ' AND ml.domain = ?';
+ push @params, $domain;
+ }
+ $sql .= ' ORDER BY ml.local_part, ml.domain';
+
+ my $dbh = $vhffs->get_db_object;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@params) or return undef;
+
+ while(my @ml = $sth->fetchrow_array) {
+ push @$mls, get_by_mladdress($vhffs, @ml);
+ }
+ return $mls;
+}
+
=pod
=head2 get_by_mladdress
- my $ml = Vhffs::Services::MailingList::get_by_mladdress($main, $local_part, $domain);
- die("Mailing list $localpart\@$domain not found\n") unless(defined $ml);
+ my $ml = Vhffs::Services::MailingList::get_by_mladdress($main, $local_part, $domain);
+ die("Mailing list $localpart\@$domain not found\n") unless(defined $ml);
Fetches the mailing list $local_part@$domain.
=cut
-
sub get_by_mladdress {
- my ($main, $local, $domain) = @_;
-
- my $dbh = $main->get_db_object();
- my $sql = 'SELECT ml.ml_id, ml.local_part, ml.domain, ml.prefix, o.owner_gid, ml.open_archive, ml.reply_to, ml.sub_ctrl, ml.post_ctrl, ml.signature, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_ml ml INNER JOIN vhffs_object o ON o.object_id = ml.object_id WHERE domain = ? and local_part = ?';
- my $sth = $dbh->prepare($sql);
- return undef unless ($sth->execute($domain, $local) > 0);
- my @params = $sth->fetchrow_array;
+ my ($main, $local, $domain) = @_;
+
+ my $dbh = $main->get_db_object();
+ my $sql = 'SELECT ml.ml_id, ml.local_part, ml.domain, ml.prefix, o.owner_gid, ml.open_archive, ml.reply_to, ml.sub_ctrl, ml.post_ctrl, ml.signature, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_ml ml INNER JOIN vhffs_object o ON o.object_id = ml.object_id WHERE domain = ? and local_part = ?';
+ my $sth = $dbh->prepare($sql);
+ return undef unless ($sth->execute($domain, $local) > 0);
+ my @params = $sth->fetchrow_array;
- push @params, fetch_subs($dbh, $params[0]);
- return _new Vhffs::Services::MailingList($main, @params);
+ push @params, fetch_subs($dbh, $params[0]);
+ return _new Vhffs::Services::MailingList($main, @params);
}
=head2 fetch_subs
- my $subs = fetch_subs($dbh, $ml_id);
+ my $subs = fetch_subs($dbh, $ml_id);
Returns an hashref of hashrefs containing all subscribers indexed on their
mail addresses.
@@ -143,423 +213,289 @@
Internal module use only.
=cut
-
sub fetch_subs {
- my ($dbh, $ml_id) = @_;
+ 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);
+ 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, 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::MailingList')) {
- $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, $open_archive, $reply_to, $sub_ctrl, $post_ctrl, $signature, $oid, $owner_uid, $date_creation, $state, $description, $subs) = @_;
-
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_ML);
- return undef unless defined($self);
-
- $self->{ml_id} = $ml_id;
- $self->{local_part} = $local_part;
- $self->{domain} = $domain,
- $self->{prefix} = $prefix;
- $self->{open_archive} = $open_archive;
- $self->{reply_to} = $reply_to;
- $self->{sub_ctrl} = $sub_ctrl;
- $self->{post_ctrl} = $post_ctrl;
- $self->{signature} = $signature;
- $self->{subs} = $subs;
-
- return $self;
-}
-
# Commit all changes of the current instance in the database
-sub commit
-{
- my $self = shift;
+sub commit {
+ my $self = shift;
- my $sql = 'UPDATE vhffs_ml SET prefix = ?, open_archive = ?, reply_to = ?, sub_ctrl = ?, post_ctrl = ?, signature = ? WHERE ml_id = ?';
- my $dbh = $self->get_main->get_db_object();
- $dbh->do($sql, undef, $self->{prefix}, $self->{open_archive}, $self->{reply_to}, $self->{sub_ctrl}, $self->{post_ctrl}, $self->{signature}, $self->{ml_id});
+ my $sql = 'UPDATE vhffs_ml SET prefix = ?, open_archive = ?, reply_to = ?, sub_ctrl = ?, post_ctrl = ?, signature = ? WHERE ml_id = ?';
+ my $dbh = $self->get_main->get_db_object();
+ $dbh->do($sql, undef, $self->{prefix}, $self->{open_archive}, $self->{reply_to}, $self->{sub_ctrl}, $self->{post_ctrl}, $self->{signature}, $self->{ml_id});
- return -3 if( $self->SUPER::commit < 0 );
-
- return 1;
+ return $self->SUPER::commit;
}
-sub change_right_for_sub
-{
- my ($self, $subscriber, $right) = @_;
+sub change_right_for_sub {
+ my ($self, $subscriber, $right) = @_;
- my $sql = 'UPDATE vhffs_ml_subscribers SET perm = ? WHERE ml_id = ? AND member = ?';
- my $dbh = $self->get_main->get_db_object();
- # FIXME compatibility hack, we should return a boolean
- return -1 unless($dbh->do($sql, undef, $right, $self->{ml_id}, $subscriber) > 0);
- $self->{subs}->{$subscriber}->{perm} = $right;
- return 1;
+ my $sql = 'UPDATE vhffs_ml_subscribers SET perm = ? WHERE ml_id = ? AND member = ?';
+ my $dbh = $self->get_main->get_db_object();
+ # FIXME compatibility hack, we should return a boolean
+ return -1 unless($dbh->do($sql, undef, $right, $self->{ml_id}, $subscriber) > 0);
+ $self->{subs}->{$subscriber}->{perm} = $right;
+ return 1;
}
+sub add_sub {
+ my $self = shift;
+ my $subscriber = lc shift;
+ my $right = shift;
-sub add_sub
-{
- my $self = shift;
- my $subscriber = lc shift;
- my $right = shift;
+ return -1 unless( Vhffs::Functions::valid_mail( $subscriber ) );
+ return -2 if $subscriber =~ /[<>\s]/;
+ return -3 unless $right =~ /^[\d]+$/;
- return -1 unless( Vhffs::Functions::valid_mail( $subscriber ) );
- return -2 if( $subscriber =~ /[<>\s]/ );
- return -3 if( ! ( $right =~ /^[\d]+$/ ) );
+ my $sql = 'INSERT INTO vhffs_ml_subscribers (member, perm, hash, ml_id, language) VALUES (?, ?, NULL, ?, NULL)';
+ my $dbh = $self->get_main->get_db_object();
+ $dbh->do($sql, undef, $subscriber, $right, $self->{ml_id}) or return -4;
- my $sql = 'INSERT INTO vhffs_ml_subscribers (member, perm, hash, ml_id, language) VALUES (?, ?, NULL, ?, NULL)';
- my $dbh = $self->get_main->get_db_object();
- $dbh->do($sql, undef, $subscriber, $right, $self->{ml_id}) or return -4;
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_ml_subscribers', undef);
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_ml_subscribers', undef);
+ $self->{subs}->{$subscriber} = {
+ sub_id => $id,
+ member => $subscriber,
+ perm => $right,
+ hash => undef,
+ ml_id => $self->{ml_id},
+ language => undef
+ };
- $self->{subs}->{$subscriber} = {
- sub_id => $id,
- member => $subscriber,
- perm => $right,
- hash => undef,
- ml_id => $self->{ml_id},
- language => undef
- };
-
- return 1;
+ return 1;
}
-
-
#add a subscriber, return undef if already exists
-sub add_sub_with_reply
-{
- my $self = shift;
- my $subscriber = lc shift;
+sub add_sub_with_reply {
+ my $self = shift;
+ my $subscriber = lc shift;
- return undef unless( Vhffs::Functions::valid_mail( $subscriber ) );
- return undef if( $subscriber =~ /.*<.*/ );
- return undef if( $subscriber =~ /.*>.*/ );
- return undef if( $subscriber =~ /.*\s.*/ );
+ return undef unless( Vhffs::Functions::valid_mail( $subscriber ) );
+ return undef if( $subscriber =~ /.*<.*/ );
+ return undef if( $subscriber =~ /.*>.*/ );
+ return undef if( $subscriber =~ /.*\s.*/ );
- my $pass = Vhffs::Functions::generate_random_password();
+ my $pass = Vhffs::Functions::generate_random_password();
- my $sql = 'INSERT INTO vhffs_ml_subscribers(member, perm, hash, ml_id, language) VALUES(?, ?, ?, ?, NULL)';
- my $dbh = $self->get_main->get_db_object();
- $dbh->do($sql, undef, $subscriber, Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_REPLY, $pass, $self->{ml_id}) or return undef;
+ my $sql = 'INSERT INTO vhffs_ml_subscribers(member, perm, hash, ml_id, language) VALUES(?, ?, ?, ?, NULL)';
+ my $dbh = $self->get_main->get_db_object();
+ $dbh->do($sql, undef, $subscriber, Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_REPLY, $pass, $self->{ml_id}) or return undef;
- my $id = $dbh->last_insert_id(undef, undef, 'vhffs_ml_subscribers', undef);
+ my $id = $dbh->last_insert_id(undef, undef, 'vhffs_ml_subscribers', undef);
- $self->{subs}->{$subscriber} = {
- sub_id => $id,
- member => $subscriber,
- perm => Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_REPLY,
- hash => $pass,
- ml_id => $self->{ml_id},
- language => undef
- };
+ $self->{subs}->{$subscriber} = {
+ sub_id => $id,
+ member => $subscriber,
+ perm => Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_REPLY,
+ hash => $pass,
+ ml_id => $self->{ml_id},
+ language => undef
+ };
- return $pass;
+ return $pass;
}
+sub del_sub {
+ my $self = shift;
+ my $subscriber = shift;
+ my $sql = 'DELETE FROM vhffs_ml_subscribers WHERE ml_id = ? AND member = ?';
+ # FIXME we should return a boolean
+ return -1 unless($self->get_main->get_db_object->do($sql, undef, $self->{ml_id}, $subscriber) > 0);
-sub del_sub
-{
- my $self = shift;
- my $subscriber = shift;
-
- my $sql = 'DELETE FROM vhffs_ml_subscribers WHERE ml_id = ? AND member = ?';
- # FIXME we should return a boolean
- return -1 unless($self->get_main->get_db_object->do($sql, undef, $self->{ml_id}, $subscriber) > 0);
-
- delete $self->{subs}->{$subscriber};
- return 1;
+ delete $self->{subs}->{$subscriber};
+ return 1;
}
-# FIXME useless
-sub change_state_for_sub
-{
- return change_right_for_sub(@_);
-}
+sub set_randomhash {
+ my $self = shift;
+ my $subscriber = shift;
+ my $pass = Vhffs::Functions::generate_random_password();
-sub set_randomhash
-{
- my $self = shift;
- my $subscriber = shift;
- my $pass = Vhffs::Functions::generate_random_password();
-
- my $sql = 'UPDATE vhffs_ml_subscribers SET hash = ? WHERE ml_id = ? AND member = ?';
- return undef unless($self->get_main->get_db_object->do($sql, undef, $pass, $self->{ml_id}, $subscriber) > 0);
-
- $self->{subs}->{$subscriber}->{hash} = $pass;
- return $pass;
+ my $sql = 'UPDATE vhffs_ml_subscribers SET hash = ? WHERE ml_id = ? AND member = ?';
+ return undef unless($self->get_main->get_db_object->do($sql, undef, $pass, $self->{ml_id}, $subscriber) > 0);
+
+ $self->{subs}->{$subscriber}->{hash} = $pass;
+ return $pass;
}
+sub clear_hash {
+ my $self = shift;
+ my $subscriber = shift;
-sub clear_hash
-{
- my $self = shift;
- my $subscriber = shift;
-
- my $sql = 'UPDATE vhffs_ml_subscribers SET hash = NULL WHERE ml_id = ? AND member = ?';
- # FIXME we should return a boolean
- return -1 unless($self->get_main->get_db_object->do($sql, undef, $self->{ml_id}, $subscriber) > 0);
-
- $self->{subs}->{$subscriber}->{hash} = undef;
- return 1;
+ my $sql = 'UPDATE vhffs_ml_subscribers SET hash = NULL WHERE ml_id = ? AND member = ?';
+ # FIXME we should return a boolean
+ return -1 unless($self->get_main->get_db_object->do($sql, undef, $self->{ml_id}, $subscriber) > 0);
+
+ $self->{subs}->{$subscriber}->{hash} = undef;
+ return 1;
}
=head2 address_exists
- print("A mailing list with the same address already exists\n")
- if Vhffs::Mailing::address_exists($vhffs, $local_part, $domain);
+ print("A mailing list with the same address already exists\n")
+ if Vhffs::Mailing::address_exists($vhffs, $local_part, $domain;
Return true if a mailing list C<$local_part>@C<$domain> already exists.
=cut
-
sub address_exists($$$) {
- my ($vhffs, $local_part, $domain) = @_;
+ my ($vhffs, $local_part, $domain) = @_;
- my $sql = 'SELECT COUNT(*) FROM vhffs_ml WHERE local_part = ? AND domain = ?';
- my $dbh = $vhffs->get_db_object();
- my $res = $dbh->selectrow_array($sql, {}, $local_part, $domain);
- return (defined($res) && $res > 0);
+ my $sql = 'SELECT COUNT(*) FROM vhffs_ml WHERE local_part = ? AND domain = ?';
+ my $dbh = $vhffs->get_db_object();
+ my $res = $dbh->selectrow_array($sql, {}, $local_part, $domain);
+ return (defined($res) && $res > 0);
}
-sub del_sub_with_reply
-{
- use Digest::MD5;
+sub del_sub_with_reply {
+ use Digest::MD5;
- my $self = shift;
- my $subscriber = shift;
+ my $self = shift;
+ my $subscriber = shift;
-
- my $hash = Digest::MD5::md5_hex( Vhffs::Functions::generate_random_password() );
+
+ my $hash = Digest::MD5::md5_hex( Vhffs::Functions::generate_random_password() );
- my $sql = 'UPDATE vhffs_ml_subscribers SET perm = ?, hash = ? WHERE ml_id = ? AND member = ? AND perm IN (?, ?)';
- # FIXME we should return a boolean
- return undef unless($self->get_main->get_db_object->do($sql, undef, Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_DEL, $hash, $self->{ml_id}, $subscriber, Vhffs::Constants::ML_RIGHT_SUB, Vhffs::Constants::ML_RIGHT_ADMIN) > 0);
+ my $sql = 'UPDATE vhffs_ml_subscribers SET perm = ?, hash = ? WHERE ml_id = ? AND member = ? AND perm IN (?, ?)';
+ # FIXME we should return a boolean
+ return undef unless($self->get_main->get_db_object->do($sql, undef, Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_DEL, $hash, $self->{ml_id}, $subscriber, Vhffs::Constants::ML_RIGHT_SUB, Vhffs::Constants::ML_RIGHT_ADMIN) > 0);
- $self->{subs}->{$subscriber}->{hash} = $hash;
- $self->{subs}->{$subscriber}->{perm} = Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_DEL;
- return $hash;
+ $self->{subs}->{$subscriber}->{hash} = $hash;
+ $self->{subs}->{$subscriber}->{perm} = Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_DEL;
+ return $hash;
}
-sub get_language_for_sub
-{
- my ($main, $sub) = @_;
+sub get_language_for_sub {
+ my ($main, $sub) = @_;
- my $sql = 'SELECT language FROM vhffs_ml_subscribers WHERE member = ?';
- my $lang = $main->get_db_object->selectrow_array($sql, undef, $sub);
- return $lang;
+ my $sql = 'SELECT language FROM vhffs_ml_subscribers WHERE member = ?';
+ my $lang = $main->get_db_object->selectrow_array($sql, undef, $sub);
+ return $lang;
}
-sub set_language_for_sub
-{
- my ($main, $sub, $language) = @_;
+sub set_language_for_sub {
+ my ($main, $sub, $language) = @_;
- $language = 'en_US' unless( $language =~ /^\w+$/ );
- my $sql = 'UPDATE vhffs_ml_subscribers SET language = ? WHERE member = ?';
- $main->get_db_object->do($sql, undef, $language, $sub) or return -1;
+ $language = 'en_US' unless( $language =~ /^\w+$/ );
+ my $sql = 'UPDATE vhffs_ml_subscribers SET language = ? WHERE member = ?';
+ $main->get_db_object->do($sql, undef, $language, $sub) or return -1;
}
-sub get_localpart
-{
- my $self = shift;
- return $self->{'local_part'};
+sub get_localpart {
+ my $self = shift;
+ return $self->{'local_part'};
}
-sub get_signature
-{
- my $self = shift;
- return $self->{signature} if defined $self->{signature} and $self->{signature} !~ /^\s*$/;
- return undef;
+sub get_signature {
+ my $self = shift;
+ return $self->{signature} if defined $self->{signature} and $self->{signature} !~ /^\s*$/;
+ return undef;
}
-sub set_signature
-{
- my ($self, $sig) = @_;
- $sig =~ s/\r\n/\n/;
- $self->{signature} = $sig;
+sub set_signature {
+ my ($self, $sig) = @_;
+ $sig =~ s/\r\n/\n/;
+ $self->{signature} = $sig;
}
-sub get_open_archive
-{
- my $self = shift;
- return $self->{'open_archive'};
+sub get_open_archive {
+ my $self = shift;
+ return $self->{'open_archive'};
}
-sub get_sub_ctrl
-{
- my $self = shift;
- return $self->{'sub_ctrl'};
+sub get_sub_ctrl {
+ my $self = shift;
+ return $self->{'sub_ctrl'};
}
-sub get_post_ctrl
-{
- my $self = shift;
- return $self->{'post_ctrl'};
+sub get_post_ctrl {
+ my $self = shift;
+ return $self->{'post_ctrl'};
}
-sub get_replyto
-{
- my $self = shift;
- return $self->{'reply_to'};
+sub get_replyto {
+ my $self = shift;
+ return $self->{'reply_to'};
}
-sub get_domain
-{
- my $self = shift;
- return $self->{'domain'};
+sub get_domain {
+ my $self = shift;
+ return $self->{'domain'};
}
-sub get_prefix
-{
- my $self = shift;
- return $self->{'prefix'};
+sub get_prefix {
+ my $self = shift;
+ return $self->{'prefix'};
}
-sub get_members
-{
- my $self = shift;
- return $self->{subs};
+sub get_members {
+ my $self = shift;
+ return $self->{subs};
}
-sub set_replytolist
-{
- my $self;
- my $string = $self->{'local_part'} ."\@" . $self->{'domain'} ;
- return $self->set_replyto( $string );
+sub set_replyto {
+ my( $self, $value ) = @_;
+ return -2 unless( $value == 0 or $value == 1);
+ $self->{'reply_to'} = $value;
+ return 1;
}
-sub set_replyto
-{
- my( $self , $value ) = @_;
- return -2 if( ( $value != 0 ) && ( $value != 1 ) );
- $self->{'reply_to'} = $value;
- return 1;
+sub set_open_archive {
+ my( $self, $value ) = @_;
+ $self->{'open_archive'} = $value;
}
-sub set_open_archive
-{
- my( $self , $value ) = @_;
- $self->{'open_archive'} = $value;
-}
-
-sub set_sub_ctrl
-{
- my( $self , $value ) = @_;
- return -1 unless ( $value =~ /\d+/ );
- return -2 if( $value < Vhffs::Constants::ML_SUBSCRIBE_NO_APPROVAL_REQUIRED || $value > Vhffs::Constants::ML_SUBSCRIBE_CLOSED );
+sub set_sub_ctrl {
+ my( $self, $value ) = @_;
+ return -1 unless $value =~ /\d+/;
+ return -2 if( $value < Vhffs::Constants::ML_SUBSCRIBE_NO_APPROVAL_REQUIRED or $value > Vhffs::Constants::ML_SUBSCRIBE_CLOSED );
$self->{'sub_ctrl'} = $value;
return 0;
}
-sub set_post_ctrl
-{
- my( $self , $value ) = @_;
- return -1 unless ( $value =~ /\d+/ );
- return -2 if ( $value < Vhffs::Constants::ML_POSTING_OPEN_ALL || $value > Vhffs::Constants::ML_POSTING_ADMINS_ONLY );
+sub set_post_ctrl {
+ my( $self, $value ) = @_;
+ return -1 unless $value =~ /\d+/;
+ return -2 if( $value < Vhffs::Constants::ML_POSTING_OPEN_ALL or $value > Vhffs::Constants::ML_POSTING_ADMINS_ONLY );
$self->{'post_ctrl'} = $value;
return 0;
}
-sub set_prefix
-{
- my( $self , $value ) = @_;
-
- $self->{'prefix'} = $value;
+sub set_prefix {
+ my( $self , $value ) = @_;
+ $self->{'prefix'} = $value;
}
-sub getall_subs
-{
- my $self = shift;
- return ( keys %{$self->{subs}} );
+sub getall_subs {
+ my $self = shift;
+ return ( keys %{$self->{subs}} );
}
-sub getall
-{
- my ($vhffs, $state, $name, $group, $domain) = @_;
-
- return undef if( ! defined $vhffs );
-
- my $mls = [];
- my @params;
- my $sql = 'SELECT local_part, domain FROM vhffs_ml ml, vhffs_object o WHERE o.object_id = ml.object_id';
-
- if(defined $state) {
- $sql .= ' AND o.state = ?';
- push @params, $state;
- }
- if(defined $group) {
- $sql .= ' AND o.owner_gid = ?';
- push @params, $group->get_gid;
- }
- if(defined $name) {
- $sql .= ' AND ( local_part LIKE ? OR domain LIKE ?)';
- push @params, '%'.$name.'%', '%'.$name.'%';
- }
- if(defined $domain) {
- $sql .= ' AND domain = ?';
- push @params, $domain;
- }
-
- $sql .= ' ORDER BY local_part, domain';
-
- my $dbh = $vhffs->get_db_object;
- my $sth = $dbh->prepare($sql);
- $sth->execute(@params) or return -3;
-
- while(my @ml = $sth->fetchrow_array) {
- push @$mls, get_by_mladdress($vhffs, @ml);
- }
- return $mls;
-}
-
-
=head2 get_label
See C<Vhffs::Object::get_label>.
=cut
-
sub get_label {
- my $self = shift;
- return $self->{local_part}.'@'.$self->{domain};
+ my $self = shift;
+ return $self->{local_part}.'@'.$self->{domain};
}
-
-
-sub get_listname
-{
- my $self = shift;
- return $self->get_localpart.'@'.$self->get_domain;
+sub get_listname {
+ my $self = shift;
+ return $self->get_localpart.'@'.$self->get_domain;
}
-
-sub get_listrequestname
-{
- my $self = shift;
- return $self->get_localpart.'-request@'.$self->get_domain;
+sub get_listrequestname {
+ my $self = shift;
+ return $self->get_localpart.'-request@'.$self->get_domain;
}
1;
Modified: trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Mercurial.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -117,7 +117,7 @@
my @params;
my $sql = 'SELECT m.mercurial_id, m.reponame, o.owner_uid, o.owner_gid, m.public, m.ml_name, o.object_id, o.date_creation, o.description, o.state
- FROM vhffs_mercurial m INNER JOIN vhffs_object o ON m.object_id = o.object_id WHERE 1=1';
+ FROM vhffs_mercurial m INNER JOIN vhffs_object o ON m.object_id = o.object_id';
if(defined $state) {
$sql .= ' AND o.state = ?';
@@ -136,7 +136,7 @@
my $dbh = $vhffs->get_db_object();
my $sth = $dbh->prepare($sql);
- $sth->execute(@params) or die($sql) ; #return undef;
+ $sth->execute(@params) or return undef;
while(my $s = $sth->fetchrow_arrayref()) {
push(@$mercurial, _new Vhffs::Services::Mercurial($vhffs, @$s));
Modified: trunk/vhffs-api/src/Vhffs/Services/Mysql.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Mysql.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Mysql.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
@@ -57,229 +57,212 @@
=head2 check_dbname
- die("Invalid DB name\n") unless Vhffs::Services::Mysql::check_dbname($dbname);
+ die("Invalid DB name\n") unless Vhffs::Services::Mysql::check_dbname($dbname);
Checks a DB name. Return false if the name isn't between 3 and 32 chars, all
numbers, lowercase letters or underscore (the latter can't be in first or last
position).
=cut
-
sub check_dbname($) {
- my $dbname = shift;
- return ($dbname =~ /^[a-z0-9][a-z0-9\_]{1,30}[a-z0-9]$/ );
+ my $dbname = shift;
+ return ($dbname =~ /^[a-z0-9][a-z0-9\_]{1,30}[a-z0-9]$/ );
}
=head2 check_dbuser
- die("Invalid DB user\n") unless Vhffs::Services::Mysql::check_dbuser($dbuser);
+ die("Invalid DB user\n") unless Vhffs::Services::Mysql::check_dbuser($dbuser);
Checks that a DB username is valid. DB name rules apply.
=cut
-
sub check_dbuser($) {
- return check_dbname($_[0]);
+ return check_dbname($_[0]);
}
+=pod
+
+=head2 check_dbpass
+
+ die('Bad DB pass') unless(Vhffs::Services::Mysql::check_dbpass($pass));
+
+Indicates wether a DB password is valid or not (at least three chars).
+
+=cut
sub check_dbpass($) {
- my $dbpass = shift;
- return ($dbpass =~ /^.{3,}$/ );
+ my $dbpass = shift;
+ return ($dbpass =~ /^.{3,}$/ );
}
+sub _new {
+ my ($class, $main, $mysql_id, $owner_gid, $dbname, $dbuser, $dbpass, $oid, $owner_uid, $date_creation, $state, $description) = @_;
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_MYSQL);
+ return undef unless(defined $self);
+
+ $self->{mysql_id} = $mysql_id;
+ $self->{dbname} = $dbname;
+ $self->{dbuser} = $dbuser;
+ $self->{dbpass} = $dbpass;
+ return $self;
+}
+
=pod
=head2 create
- my $mysql = Vhffs::Services::Mysql::create($main, $dbname, $dbuser, $dbpass, $description, $user, $group);
- die("Unable to create MySQL service $dbname\n") unless(defined $mysql);
+ my $mysql = Vhffs::Services::Mysql::create($main, $dbname, $dbuser, $dbpass, $description, $user, $group);
+ die("Unable to create MySQL service $dbname\n") unless(defined $mysql);
Creates a new MySQL service in VHFFS database and returns the fully functional object.
=cut
-
sub create {
- my ($main, $dbname, $dbuser, $dbpass, $description, $user, $group) = @_;
- return undef unless(defined($user) && defined($group));
- return undef unless(check_dbname($dbname) && check_dbpass($dbpass) && check_dbuser($dbuser));
+ my ($main, $dbname, $dbuser, $dbpass, $description, $user, $group) = @_;
+ return undef unless(defined($user) && defined($group));
+ return undef unless(check_dbname($dbname) && check_dbpass($dbpass) && check_dbuser($dbuser));
- my $mysql;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
+ my $mysql;
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
- eval {
+ eval {
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_MYSQL);
- die('Unable to create parent object') unless defined ($parent);
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_MYSQL);
+ die('Unable to create parent object') unless defined ($parent);
- my $sth = $dbh->prepare( 'INSERT INTO vhffs_mysql(dbname, dbuser, dbpass, object_id) VALUES(?, ?, ?, ?)' );
- $sth->execute($dbname, $dbuser, $dbpass, $parent->get_oid);
+ my $sth = $dbh->prepare( 'INSERT INTO vhffs_mysql(dbname, dbuser, dbpass, object_id) VALUES(?, ?, ?, ?)' );
+ $sth->execute($dbname, $dbuser, $dbpass, $parent->get_oid);
- $dbh->commit;
- $mysql = get_by_dbname($main, $dbname);
- };
+ $dbh->commit;
+ $mysql = get_by_dbname($main, $dbname);
+ };
- if($@) {
- warn "Unable to create MySQL db $dbname: $@\n";
- $dbh->rollback;
- }
+ if($@) {
+ warn 'Unable to create MySQL db '.$dbname.': '.$@."\n";
+ $dbh->rollback;
+ }
- return $mysql;
+ return $mysql;
}
-sub commit
-{
- my $self = shift;
- my $dbh = $self->get_db_object();
- $dbh->do('UPDATE vhffs_mysql SET dbpass = ? WHERE dbname = ?', undef,
- $self->{dbpass}, $self->{dbname}) or return -1;
- return $self->SUPER::commit;
-}
+=head2 fill_object
-sub get_dbusername
-{
- my $self = shift;
- return $self->{'dbuser'};
-}
+See C<Vhffs::Object::fill_object>
-sub get_dbname
-{
- my $self = shift;
- return $self->{'dbname'};
-}
-
-=head2 get_label
-
-See C<Vhffs::Object::get_label>.
-
=cut
-
-sub get_label {
- my $self = shift;
- return $self->{dbname};
+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 get_dbpassword
-{
- my $self = shift;
- return $self->{'dbpass'};
-}
+sub getall {
+ my ($vhffs, $state, $name, $group) = @_;
-sub blank_password
-{
- my $self = shift;
+ my $mysql = [];
+ my @params;
- my $request = $self->{'db'}->prepare('UPDATE vhffs_mysql SET dbpass=\'\' WHERE dbname=?') or return -1;
- $request->execute( $self->get_dbname );
- return 1;
-}
+ my $sql = 'SELECT m.mysql_id, o.owner_gid, m.dbname, m.dbuser, m.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description
+ FROM vhffs_mysql m INNER JOIN vhffs_object o ON m.object_id = o.object_id';
-sub set_dbusername
-{
- my ($self , $value) = @_;
+ if(defined $state) {
+ $sql .= ' AND o.state = ?';
+ push(@params, $state);
+ }
+ if(defined $name) {
+ $sql .= ' AND m.dbname LIKE ?';
+ push(@params, '%'.$name.'%');
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid = ?';
+ push(@params, $group->get_gid);
+ }
+ $sql .= ' ORDER BY m.dbname';
- return 1 if( $value eq $self->{'dbuser'});
+ my $dbh = $vhffs->get_db_object();
- my $request = $self->{'db'}->prepare('SELECT * FROM vhffs_mysql where dbuser=?') or return -1;
- my $rows = $request->execute( $value );
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@params) or return undef;
- return -1 if( $rows >= 1 );
-
- $self->{'dbuser'} = $value;
- return 1;
+ while(my $s = $sth->fetchrow_arrayref()) {
+ push(@$mysql, _new Vhffs::Services::Mysql($vhffs, @$s));
+ }
+ return $mysql;
}
-sub set_dbpassword
-{
- my ($self , $value) = @_;
- return -1 unless(check_dbpass($value));
- $self->{'dbpass'} = $value;
- return 1;
-}
-
-sub _new {
- my ($class, $main, $mysql_id, $owner_gid, $dbname, $dbuser, $dbpass, $oid, $owner_uid, $date_creation, $state, $description) = @_;
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_MYSQL);
- return undef unless(defined $self);
-
- $self->{mysql_id} = $mysql_id;
- $self->{dbname} = $dbname;
- $self->{dbuser} = $dbuser;
- $self->{dbpass} = $dbpass;
- return $self;
-}
-
=pod
=head2 get_by_dbname
- my $mysql = Vhffs::Services::Mysql::get_by_dbname($main, $dbname);
- die("MySQL service $dbname not found\n") unless(defined $mysql);
+ my $mysql = Vhffs::Services::Mysql::get_by_dbname($main, $dbname);
+ die("MySQL service $dbname not found\n") unless(defined $mysql);
Fetches the MySQL service $dbname.
=cut
-
sub get_by_dbname($$) {
- my ($vhffs, $dbname) = @_;
+ my ($vhffs, $dbname) = @_;
- my $sql = q{SELECT m.mysql_id, o.owner_gid, m.dbname, m.dbuser, m.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_mysql m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE m.dbname = ?};
- my $dbh = $vhffs->get_db_object();
- my @params;
- return undef unless(@params = $dbh->selectrow_array($sql, undef, $dbname));
+ my $sql = q{SELECT m.mysql_id, o.owner_gid, m.dbname, m.dbuser, m.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_mysql m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE m.dbname = ?};
+ my $dbh = $vhffs->get_db_object();
+ my @params;
+ return undef unless(@params = $dbh->selectrow_array($sql, undef, $dbname));
- return _new Vhffs::Services::Mysql($vhffs, @params);
+ return _new Vhffs::Services::Mysql($vhffs, @params);
}
-=head2 fill_object
+sub commit {
+ my $self = shift;
-See C<Vhffs::Object::fill_object>
+ my $sql = 'UPDATE vhffs_mysql SET dbuser = ?, dbpass = ? WHERE mysql_id = ?';
+ my $sth = $self->get_db_object()->prepare( $sql );
+ $sth->execute($self->{dbuser}, $self->{dbpass}, $self->{mysql_id});
-=cut
+ return $self->SUPER::commit;
+}
-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 get_dbusername {
+ my $self = shift;
+ return $self->{'dbuser'};
}
-sub getall
-{
- my ($vhffs, $state, $name, $group) = @_;
+sub get_dbname {
+ my $self = shift;
+ return $self->{'dbname'};
+}
- my $mysql = [];
- my @params;
-
- my $sql = 'SELECT m.mysql_id, o.owner_gid, m.dbname, m.dbuser, m.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_mysql m, vhffs_object o WHERE m.object_id = o.object_id';
+=head2 get_label
- if(defined $state) {
- $sql .= ' AND o.state = ?';
- push(@params, $state);
- }
- if(defined $name) {
- $sql .= ' AND m.dbname LIKE ?';
- push(@params, '%'.$name.'%');
- }
- if(defined $group) {
- $sql .= ' AND o.owner_gid = ?';
- push(@params, $group->get_gid);
- }
+See C<Vhffs::Object::get_label>.
- my $dbh = $vhffs->get_db_object();
- my $sth = $dbh->prepare($sql);
+=cut
+sub get_label {
+ my $self = shift;
+ return $self->{dbname};
+}
- return undef unless($sth->execute(@params));
+sub get_dbpassword {
+ my $self = shift;
+ return $self->{'dbpass'};
+}
- while(my $row = $sth->fetchrow_arrayref()) {
- push(@$mysql, _new Vhffs::Services::Mysql($vhffs, @$row));
- }
+sub blank_password {
+ my $self = shift;
- return $mysql;
+ my $request = $self->{'db'}->prepare('UPDATE vhffs_mysql SET dbpass=\'\' WHERE mysql_id=?') or return -1;
+ $request->execute( $self->{mysql_id} );
+ return 1;
}
+sub set_dbpassword {
+ my ($self , $value) = @_;
+ return -1 unless check_dbpass($value);
+ $self->{'dbpass'} = $value;
+ return 1;
+}
1;
__END__
Modified: trunk/vhffs-api/src/Vhffs/Services/Newsletter.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Newsletter.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Newsletter.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
@@ -44,7 +44,7 @@
use constant {
ACTIVE_OPTIN => 1,
- PASSIVE_OPTIN => 2,
+ PASSIVE_OPTIN => 2,
ACTIVE_OPTOUT => 3,
PASSIVE_OPTOUT => 4,
PERMANENT => 5,
Modified: trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Pgsql.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
@@ -58,239 +58,216 @@
=head2 check_dbname
- die('Bad DB name') unless(Vhffs::Services::Pgsql::check_dbname($dbname));
+ die('Bad DB name') unless(Vhffs::Services::Pgsql::check_dbname($dbname));
Indicates wether a DB name is valid or not (3 to 32 alphanumeric chars, underscore
allowed except at begining and end).
=cut
-
sub check_dbname($) {
- my $dbname = shift;
- return ( $dbname =~ /^[a-z0-9][a-z0-9\_]{1,30}[a-z0-9]$/ );
+ my $dbname = shift;
+ return ( $dbname =~ /^[a-z0-9][a-z0-9\_]{1,30}[a-z0-9]$/ );
}
=pod
=head2 check_dbuser
- die('Bad DB username') unless(Vhffs::Services::Pgsql::check_dbuser($user));
+ die('Bad DB username') unless(Vhffs::Services::Pgsql::check_dbuser($user));
Indicates wether a DB user name is valid or not (3 to 32 lowercase alphanumeric chars, underscore
allowed except at begining and end).
=cut
-
sub check_dbuser($) {
- return check_dbname($_[0]);
+ return check_dbname($_[0]);
}
-
=pod
-=head2 check_dbuser
+=head2 check_dbpass
- die('Bad DB pass') unless(Vhffs::Services::Pgsql::check_dbpass($pass));
+ die('Bad DB pass') unless(Vhffs::Services::Pgsql::check_dbpass($pass));
Indicates wether a DB password is valid or not (at least three chars).
=cut
-
-
sub check_dbpass($) {
- my $dbpass = shift;
- return ( $dbpass =~ /^.{3,}$/);
+ my $dbpass = shift;
+ return ( $dbpass =~ /^.{3,}$/);
}
+sub _new {
+ my ($class, $main, $pgsql_id, $owner_gid, $dbname, $dbuser, $dbpass, $oid, $owner_uid, $date_creation, $state, $description) = @_;
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_PGSQL);
+ return undef unless(defined $self);
+ $self->{pgsql_id} = $pgsql_id;
+ $self->{dbname} = $dbname;
+ $self->{dbuser} = $dbuser;
+ $self->{dbpass} = $dbpass;
+ return $self;
+}
+
=pod
=head2 create
- my $psql = Vhffs::Services::Pgsql::create($main, $dbname, $dbuser, $dbpass, $description, $user, $group);
- die("Unable to create Postgre Service\n") unless(defined $psql);
+ my $psql = Vhffs::Services::Pgsql::create($main, $dbname, $dbuser, $dbpass, $description, $user, $group);
+ die("Unable to create Postgre Service\n") unless(defined $psql);
Create a new Postgres services and return the corresponding fully functional object.
=cut
-
sub create {
- my ($main, $dbname, $dbuser, $dbpass, $description, $user, $group) = @_;
- return undef unless(defined($user) && defined($group));
- return undef unless(check_dbname($dbname) && check_dbpass($dbpass) && check_dbuser($dbuser));
+ my ($main, $dbname, $dbuser, $dbpass, $description, $user, $group) = @_;
+ return undef unless(defined($user) && defined($group));
+ return undef unless(check_dbname($dbname) && check_dbpass($dbpass) && check_dbuser($dbuser));
- my $pg;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
+ my $pg;
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
- eval {
+ eval {
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_PGSQL);
- die('Unable to create parent object') unless defined ($parent);
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_PGSQL);
+ die('Unable to create parent object') unless defined ($parent);
- my $sql = 'INSERT INTO vhffs_pgsql(dbname, dbuser, dbpass, object_id) VALUES(?, ?, ?, ?)';
- my $sth = $dbh->prepare($sql);
- $sth->execute($dbname, $dbuser, $dbpass, $parent->get_oid);
+ my $sql = 'INSERT INTO vhffs_pgsql(dbname, dbuser, dbpass, object_id) VALUES(?, ?, ?, ?)';
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($dbname, $dbuser, $dbpass, $parent->get_oid);
- $dbh->commit;
- $pg = get_by_dbname($main, $dbname);
- };
+ $dbh->commit;
+ $pg = get_by_dbname($main, $dbname);
+ };
- if($@) {
- warn "Unable to create PostgreSQL database $dbname: $@\n";
- $dbh->rollback;
- }
+ if($@) {
+ warn 'Unable to create PostgreSQL database '.$dbname.': '.$@."\n";
+ $dbh->rollback;
+ }
- return $pg;
-
+ return $pg;
}
-sub commit
-{
- my $self = shift;
+=head2 fill_object
- my $sql = 'UPDATE vhffs_pgsql SET dbuser = ?, dbpass = ? WHERE pgsql_id = ?';
- my $sth = $self->get_db_object()->prepare( $sql );
- $sth->execute($self->{dbuser}, $self->{dbpass}, $self->{pgsql_id});
+See C<Vhffs::Object::fill_object>.
-
- $self->SUPER::commit;
+=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 get_dbusername
-{
- my $self = shift;
- return $self->{'dbuser'};
-}
+sub getall {
+ my ($vhffs, $state, $name, $group) = @_;
-sub get_dbname
-{
- my $self = shift;
- return $self->{'dbname'};
-}
+ my $postgres = [];
+ my @params;
-sub get_label {
- my $self = shift;
- return $self->{dbname};
-}
+ my $sql = 'SELECT p.pgsql_id, o.owner_gid, p.dbname, p.dbuser, p.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description
+ FROM vhffs_pgsql p INNER JOIN vhffs_object o ON o.object_id = p.object_id';
+ if(defined $state) {
+ $sql .= ' AND o.state = ?';
+ push(@params, $state);
+ }
+ if(defined $name) {
+ $sql .= ' AND p.dbname LIKE ?';
+ push(@params, '%'.$name.'%');
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid = ?';
+ push(@params, $group->get_gid);
+ }
+ $sql .= ' ORDER BY p.dbname';
-sub get_dbpassword
-{
- my $self = shift;
- return $self->{'dbpass'};
-}
+ my $dbh = $vhffs->get_db_object();
-sub set_dbusername
-{
- my ($self , $value) = @_;
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@params) or return undef;
- return 1 if( $value eq $self->{'dbuser'});
+ while(my $row = $sth->fetchrow_arrayref()) {
+ push(@$postgres, _new Vhffs::Services::Pgsql($vhffs, @$row));
+ }
- return -1 if(! check_dbuser($value));
-
- $self->{'dbuser'} = $value;
- return 1;
+ return $postgres;
}
-sub set_dbpassword
-{
- my $self = shift;
- my $value = shift;
- return -1 if( ! check_dbpass( $value ) );
- $self->{'dbpass'} = $value;
- return 1;
-}
-
-sub blank_password
-{
- my $self = shift;
-
- my $request = $self->{'db'}->prepare('UPDATE vhffs_pgsql SET dbpass=\'\' WHERE dbname=?') or return -1;
- $request->execute( $self->get_dbname );
- return 1;
-}
-
-sub _new {
- my ($class, $main, $pgsql_id, $owner_gid, $dbname, $dbuser, $dbpass, $oid, $owner_uid, $date_creation, $state, $description) = @_;
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_PGSQL);
- return undef unless(defined $self);
-
- $self->{pgsql_id} = $pgsql_id;
- $self->{dbname} = $dbname;
- $self->{dbuser} = $dbuser;
- $self->{dbpass} = $dbpass;
- return $self;
-}
-
=pod
=head2 get_by_dbname
- my $pg = Vhffs::Services::Pgsql::get_by_dbname($main, $dbname);
- die("No database with this name") unless(defined $pg);
+ my $pg = Vhffs::Services::Pgsql::get_by_dbname($main, $dbname);
+ die("No database with this name") unless(defined $pg);
Fetches the pg database whose name is C<$dbname>.
=cut
-
sub get_by_dbname($$) {
- my ($vhffs, $dbname) = @_;
+ my ($vhffs, $dbname) = @_;
- my $sql = q{SELECT m.pgsql_id, o.owner_gid, m.dbname, m.dbuser, m.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_pgsql m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE m.dbname = ?};
- my $dbh = $vhffs->get_db_object();
- my @params;
- return undef unless(@params = $dbh->selectrow_array($sql, undef, $dbname));
+ my $sql = q{SELECT m.pgsql_id, o.owner_gid, m.dbname, m.dbuser, m.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_pgsql m INNER JOIN vhffs_object o ON o.object_id = m.object_id WHERE m.dbname = ?};
+ my $dbh = $vhffs->get_db_object();
+ my @params;
+ return undef unless(@params = $dbh->selectrow_array($sql, undef, $dbname));
- return _new Vhffs::Services::Pgsql($vhffs, @params);
+ return _new Vhffs::Services::Pgsql($vhffs, @params);
}
-=head2 fill_object
+sub commit {
+ my $self = shift;
-See C<Vhffs::Object::fill_object>.
+ my $sql = 'UPDATE vhffs_pgsql SET dbuser = ?, dbpass = ? WHERE pgsql_id = ?';
+ my $sth = $self->get_db_object()->prepare( $sql );
+ $sth->execute($self->{dbuser}, $self->{dbpass}, $self->{pgsql_id});
-=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);
+ return $self->SUPER::commit;
}
-sub getall
-{
- my ($vhffs, $state, $name, $group) = @_;
+sub get_dbusername {
+ my $self = shift;
+ return $self->{'dbuser'};
+}
- my $postgres = [];
- my @params;
+sub get_dbname {
+ my $self = shift;
+ return $self->{'dbname'};
+}
- my $sql = 'SELECT p.pgsql_id, o.owner_gid, p.dbname, p.dbuser, p.dbpass, o.object_id, o.owner_uid, o.date_creation, o.state, o.description FROM vhffs_pgsql p, vhffs_object o WHERE p.object_id = o.object_id';
+=head2 get_label
- if(defined $state) {
- $sql .= ' AND o.state = ?';
- push(@params, $state);
- }
- if(defined $name) {
- $sql .= ' AND p.dbname LIKE ?';
- push(@params, '%'.$name.'%');
- }
- if(defined $group) {
- $sql .= ' AND o.owner_gid = ?';
- push(@params, $group->get_gid);
- }
+See C<Vhffs::Object::get_label>.
- my $dbh = $vhffs->get_db_object();
- my $sth = $dbh->prepare($sql);
+=cut
+sub get_label {
+ my $self = shift;
+ return $self->{dbname};
+}
- return undef unless($sth->execute(@params));
+sub get_dbpassword {
+ my $self = shift;
+ return $self->{'dbpass'};
+}
- while(my $row = $sth->fetchrow_arrayref()) {
- push(@$postgres, _new Vhffs::Services::Pgsql($vhffs, @$row));
- }
+sub set_dbpassword {
+ my $self = shift;
+ my $value = shift;
+ return -1 unless check_dbpass( $value );
+ $self->{'dbpass'} = $value;
+ return 1;
+}
- return $postgres;
+sub blank_password {
+ my $self = shift;
+
+ my $request = $self->{'db'}->prepare('UPDATE vhffs_pgsql SET dbpass=\'\' WHERE pgsql_id=?') or return -1;
+ $request->execute( $self->{pgsql_id} );
+ return 1;
}
1;
Modified: trunk/vhffs-api/src/Vhffs/Services/Repository.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Repository.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Repository.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+# 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
+# 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.
# This file is a part of VHFFS4 Hosting Platform
@@ -53,208 +53,188 @@
package Vhffs::Services::Repository;
use base qw(Vhffs::Object);
-use Vhffs::Group;
use DBI;
-sub check_name($)
-{
- my $name = shift;
- return ($name =~ /^[a-z0-9]+$/);
+sub check_name($) {
+ my $name = shift;
+ return ($name =~ /^[a-z0-9]+$/);
}
+sub _new {
+ my ($class, $main, $repository_id, $name, $owner_uid, $owner_gid, $quota, $quota_used, $oid, $date_creation, $description, $state) = @_;
+
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_REPOSITORY);
+ return undef unless defined $self;
+
+ $self->{repository_id} = $repository_id;
+ $self->{name} = $name;
+ $self->{quota} = $quota;
+ $self->{quota_used} = $quota_used;
+
+ return $self;
+}
+
=pod
=head2 create
- my $repo = Vhffs::Services::Repository::create($main, $rname, $description, $user, $group);
- die('Unable to create repository) unless(defined $repo);
+ my $repo = Vhffs::Services::Repository::create($main, $rname, $description, $user, $group);
+ die('Unable to create repository) unless(defined $repo);
Creates a new download repository in database and return the corresponding
fully functional object.
=cut
+sub create {
+ my ($main, $rname, $description, $user, $group) = @_;
+ return undef unless defined $user and defined $group;
+ return undef unless check_name($rname);
-sub create
-{
- my ($main, $rname, $description, $user, $group) = @_;
+ my $repo;
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
- return undef unless(defined($user) && defined($group));
- return undef unless(check_name($rname));
+ eval {
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_REPOSITORY);
+ die('Unable to create parent object') unless(defined $parent);
- my $repo;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
+ my $sql = 'INSERT INTO vhffs_repository(name, quota, quota_used, object_id) VALUES(?, ?, 0, ?)';
- eval {
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_REPOSITORY);
- die('Unable to create parent object') unless(defined $parent);
+ #Quota
+ my $config = $main->get_config()->get_service('repository');
+ my $quota = $config->{'default_quota'} if defined($config);
+ $quota = 100 unless defined $quota;
- my $sql = 'INSERT INTO vhffs_repository(name, quota, quota_used, object_id) VALUES(?, ?, 0, ?)';
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($rname, $quota, $parent->get_oid);
- #Quota
- my $config = $main->get_config()->get_service('repository');
- my $quota = $config->{'default_quota'} if defined($config);
- $quota = 100 unless defined($quota);
+ $dbh->commit;
+ $repo = get_by_reponame($main, $rname);
+ };
- my $sth = $dbh->prepare($sql);
- $sth->execute($rname, $quota, $parent->get_oid);
+ if($@) {
+ warn 'Unable to create repository '.$rname.': '.$@."\n";
+ $dbh->rollback;
+ }
- $dbh->commit;
- $repo = get_by_reponame($main, $rname);
- };
-
- if($@) {
- warn "Unable to create repository $rname: $@\n";
- $dbh->rollback;
- }
-
- return $repo;
+ return $repo;
}
-=pod
+=head2 fill_object
-=head2 get_by_reponame
+See C<Vhffs::Object::fill_object
- my $repo = Vhffs::Services::Repository::get_by_reponame($main, $name);
- die('Repository not found') unless(defined $repo);
-
-Fetches an existing repository.
-
=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 get_by_reponame($$) {
- my ($main, $name) = @_;
+sub getall {
+ my ($vhffs, $state, $name, $group) = @_;
- my @params;
+ my $repos = [];
+ my @params;
- my $sql = 'SELECT r.repository_id, r.name, o.owner_uid, o.owner_gid, r.quota, r.quota_used, o.object_id, o.date_creation, o.description, o.state FROM vhffs_repository r INNER JOIN vhffs_object o ON o.object_id = r.object_id WHERE r.name = ?';
+ my $sql = 'SELECT r.repository_id, r.name, o.owner_uid, o.owner_gid, r.quota, r.quota_used, o.object_id, o.date_creation, o.description, o.state
+ FROM vhffs_repository r INNER JOIN vhffs_object o ON o.object_id = r.object_id';
+ if(defined $state) {
+ $sql .= ' AND o.state = ?';
+ push(@params, $state);
+ }
+ if(defined $name) {
+ $sql .= ' AND r.name LIKE ?';
+ push(@params, '%'.$name.'%');
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid = ?';
+ push(@params, $group->get_gid);
+ }
+ $sql .= ' ORDER BY r.name';
- my $dbh = $main->get_db_object();
- return undef unless(@params = $dbh->selectrow_array($sql, undef, $name));
+ my $dbh = $vhffs->get_db_object();
- return _new Vhffs::Services::Repository($main, @params);
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@params) or return undef;
+
+ while(my $r = $sth->fetchrow_arrayref()) {
+ push(@$repos, _new Vhffs::Services::Repository($vhffs, @$r));
+ }
+ return $repos;
}
-=head2 fill_object
+=pod
-See C<Vhffs::Object::fill_object
+=head2 get_by_reponame
-=cut
+ my $repo = Vhffs::Services::Repository::get_by_reponame($main, $name);
+ die('Repository not found') unless(defined $repo);
-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);
-}
+Fetches an existing repository.
-sub _new {
- my ($class, $main, $repository_id, $name, $owner_uid, $owner_gid, $quota, $quota_used, $oid, $date_creation, $description, $state) = @_;
+=cut
+sub get_by_reponame($$) {
+ my ($main, $name) = @_;
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_REPOSITORY);
- return undef unless(defined $self);
+ my @params;
- $self->{repository_id} = $repository_id;
- $self->{name} = $name;
- $self->{quota} = $quota;
- $self->{quota_used} = $quota_used;
+ my $sql = 'SELECT r.repository_id, r.name, o.owner_uid, o.owner_gid, r.quota, r.quota_used, o.object_id, o.date_creation, o.description, o.state FROM vhffs_repository r INNER JOIN vhffs_object o ON o.object_id = r.object_id WHERE r.name = ?';
- return $self;
+ my $dbh = $main->get_db_object();
+ return undef unless(@params = $dbh->selectrow_array($sql, undef, $name));
+
+ return _new Vhffs::Services::Repository($main, @params);
}
-sub commit
-{
+sub commit {
my $self = shift;
- my $query = "UPDATE vhffs_repository SET name='".$self->{'name'}."', quota='".$self->{'quota'}."', quota_used='".$self->{'quota_used'}."' WHERE repository_id='".$self->{'repository_id'}."'";
-
+ my $query = 'UPDATE vhffs_repository SET name=?, quota=?, quota_used=? WHERE repository_id=?';
my $request = $self->{'db'}->prepare($query);
- $request->execute or return -1;
+ $request->execute( $self->{'name'}, $self->{'quota'}, $self->{'quota_used'}, $self->{'repository_id'} ) or return -1;
- return -2 if( $self->SUPER::commit < 0 );
- return 1;
+ return $self->SUPER::commit;
}
-
-sub getall
-{
- my ($vhffs, $state, $name, $group) = @_;
-
- my $repos = [];
- my @params;
-
- my $sql = 'SELECT r.repository_id, r.name, o.owner_uid, o.owner_gid, r.quota, r.quota_used, o.object_id, o.date_creation, o.description, o.state FROM vhffs_repository r, vhffs_object o WHERE r.object_id = o.object_id';
- if(defined($state)) {
- $sql .= ' AND o.state = ?';
- push(@params, $state);
- }
- if(defined $name) {
- $sql .= ' AND r.name = ?';
- push(@params, $name);
- }
- if(defined($group)) {
- $sql .= ' AND o.owner_gid = ?';
- push(@params, $group->get_gid);
- }
- $sql .= ' ORDER BY r.name';
-
- my $dbh = $vhffs->get_db_object();
-
- my $sth = $dbh->prepare($sql);
- $sth->execute(@params) or return undef;
-
- while(my $r = $sth->fetchrow_arrayref()) {
- push(@$repos, _new Vhffs::Services::Repository($vhffs, @$r));
- }
- return $repos;
-}
-
sub get_label {
my $self = shift;
return $self->{name};
}
-sub get_name
-{
+sub get_name {
my $self = shift;
return $self->{'name'};
}
-sub get_quota
-{
+sub get_quota {
my $self = shift;
return $self->{'quota'};
}
-sub set_quota
-{
- my ($self , $value) = @_;
+sub set_quota {
+ my ($self, $value) = @_;
$self->{'quota'} = $value;
}
-sub get_quota_used
-{
+sub get_quota_used {
my $self = shift;
return $self->{'quota_used'};
}
-sub set_quota_used
-{
- my ($self , $value) = @_;
+sub set_quota_used {
+ my ($self, $value) = @_;
$self->{'quota_used'} = $value;
}
-sub get_dir
-{
- my $self = shift;
- return undef if( ! defined $self );
-
- return( $self->{'main'}->get_config->get_datadir . "/repository/" . $self->get_name );
+sub get_dir {
+ my $self = shift;
+ return $self->{'main'}->get_config->get_datadir.'/repository/'.$self->get_name;
}
-
1;
__END__
Modified: trunk/vhffs-api/src/Vhffs/Services/Svn.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Svn.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Svn.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -119,7 +119,7 @@
my @params;
my $sql = 'SELECT s.svn_id, s.reponame, o.owner_uid, o.owner_gid, s.public, s.ml_name, o.object_id, o.date_creation, o.description, o.state
- FROM vhffs_svn s INNER JOIN vhffs_object o ON s.object_id = o.object_id WHERE 1=1';
+ FROM vhffs_svn s INNER JOIN vhffs_object o ON s.object_id = o.object_id';
if(defined $state) {
$sql .= ' AND o.state = ?';
Modified: trunk/vhffs-api/src/Vhffs/Services/Web.pm
===================================================================
--- trunk/vhffs-api/src/Vhffs/Services/Web.pm 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-api/src/Vhffs/Services/Web.pm 2012-02-19 15:14:31 UTC (rev 2024)
@@ -2,31 +2,31 @@
# 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
+# 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
+# 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
+# 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
+#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
+#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.
@@ -57,51 +57,125 @@
use base qw(Vhffs::Object);
use DBI;
+sub _new {
+ my ($class, $main, $httpd_id, $servername, $owner_uid, $owner_gid, $oid, $date_creation, $description, $state) = @_;
+
+ my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_WEB);
+ return undef unless(defined($self));
+
+ $self->{http_id} = $httpd_id;
+ $self->{servername} = $servername;
+
+ return $self;
+}
+
=pod
=head2 create
- my $httpd = Vhffs::Services::Web::create($main, $servername, $description, $user, $group);
- die("Unable to create webarea $servername\n") unless(defined $httpd);
+ my $httpd = Vhffs::Services::Web::create($main, $servername, $description, $user, $group);
+ die("Unable to create webarea $servername\n") unless(defined $httpd);
Creates a new webarea in database and returns the corresponding fully functional object.
=cut
+sub create {
+ my ($main, $servername, $description, $user, $group) = @_;
+ return undef unless defined $user and defined $group;
+ return undef unless Vhffs::Functions::check_domain_name($servername);
-sub create
-{
- my ($main, $servername, $description, $user, $group) = @_;
- return undef unless(defined($user) && defined($group));
- return undef unless(Vhffs::Functions::check_domain_name($servername));
+ my $web;
+ my $dbh = $main->get_db_object();
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->begin_work;
- my $web;
- my $dbh = $main->get_db_object();
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->begin_work;
+ eval {
+ my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_WEB);
- eval {
- my $parent = Vhffs::Object::create($main, $user->get_uid, $group->get_gid, $description, undef, Vhffs::Constants::TYPE_WEB);
-
- die('Unable to create parent object') unless(defined($parent));
+ die('Unable to create parent object') unless(defined($parent));
- my $sql = 'INSERT INTO vhffs_httpd(servername, object_id) VALUES(?, ?)';
+ my $sql = 'INSERT INTO vhffs_httpd(servername, object_id) VALUES(?, ?)';
- my $sth = $dbh->prepare($sql);
- $sth->execute($servername, $parent->get_oid);
+ my $sth = $dbh->prepare($sql);
+ $sth->execute($servername, $parent->get_oid);
- $dbh->commit;
- $web = get_by_servername($main, $servername);
- };
+ $dbh->commit;
+ $web = get_by_servername($main, $servername);
+ };
- if($@) {
- warn "Unable to create webarea $servername: $@\n";
- $dbh->rollback;
- }
- return $web;
+ if($@) {
+ warn 'Unable to create webarea '.$servername.': '.$@."\n";
+ $dbh->rollback;
+ }
+ return $web;
}
+=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);
+}
+
+sub getall {
+ my ($vhffs, $state, $name, $group) = @_;
+
+ my $web = [];
+ my @params;
+
+ my $sql = 'SELECT h.httpd_id, h.servername, o.owner_uid, o.owner_gid, h.object_id, o.date_creation, o.description, o.state
+ FROM vhffs_httpd h INNER JOIN vhffs_object o ON o.object_id = h.object_id';
+ if(defined $state) {
+ $sql .= ' AND o.state = ?';
+ push(@params, $state);
+ }
+ if(defined $name) {
+ $sql .= ' AND h.servername LIKE ?';
+ push(@params, '%'.$name.'%');
+ }
+ if(defined $group) {
+ $sql .= ' AND o.owner_gid = ?';
+ push(@params, $group->get_gid);
+ }
+ $sql .= ' ORDER BY h.servername';
+
+ my $dbh = $vhffs->get_db_object();
+
+ my $sth = $dbh->prepare($sql);
+ $sth->execute(@params) or return undef;
+
+ while( my $s = $sth->fetchrow_arrayref() ) {
+ push( @{$web}, _new Vhffs::Services::Web($vhffs, @$s) );
+ }
+ return $web;
+}
+
+=head2 get_by_servername
+
+ my $httpd = Vhffs::Services::Web::get_by_servername($main, $servername);
+ die("Webarea $servername not found\n") unless(defined $httpd);
+
+Fetches the webarea whose address is C<$servername>.
+
+=cut
+sub get_by_servername {
+ my ($main, $servername) = @_;
+ my $sql = 'SELECT h.httpd_id, h.servername, o.owner_uid, o.owner_gid, h.object_id, o.date_creation, o.description, o.state
+ FROM vhffs_httpd h INNER JOIN vhffs_object o ON o.object_id = h.object_id WHERE h.servername = ?';
+
+ my $dbh = $main->get_db_object();
+ my @params;
+ return undef unless(@params = $dbh->selectrow_array($sql, undef, $servername));
+
+ return _new Vhffs::Services::Web($main, @params);
+}
+
=pod
=head2 commit
@@ -109,36 +183,30 @@
Commit modified changes to the database.
=cut
-
-sub commit
-{
+sub commit {
my $self = shift;
- $self->SUPER::commit;
+ return $self->SUPER::commit;
}
=head2 get_servername
- my $servername = $httpd->get_servername;
+ my $servername = $httpd->get_servername;
Returns webarea server name.
=cut
-
-sub get_servername
-{
+sub get_servername {
my $self = shift;
return $self->{'servername'};
}
-
=head2 get_dir
- my $dir = $httpd->get_dir;
+ my $dir = $httpd->get_dir;
Returns webarea directory.
=cut
-
sub get_dir {
my $self = shift;
require Digest::MD5;
@@ -148,12 +216,11 @@
=head2 get_hash
- my $dir = $httpd->get_hash;
+ my $dir = $httpd->get_hash;
Same as get_dir, but only return the hashed part.
=cut
-
sub get_hash {
my $self = shift;
require Digest::MD5;
@@ -166,131 +233,11 @@
See C<Vhffs::Object::get_label>.
=cut
-
sub get_label {
- my $self = shift;
- return $self->{servername};
+ my $self = shift;
+ return $self->{servername};
}
-sub getall
-{
- my ($vhffs, $state, $name, $group) = @_;
-
- my $sql;
- my @params;
- my $sth;
-
- my $objs = [];
- my $result;
- my $tmp;
-
- $sql = 'SELECT h.httpd_id, h.servername, o.owner_uid, o.owner_gid, h.object_id, o.date_creation, o.description, o.state FROM vhffs_httpd h INNER JOIN vhffs_object o ON o.object_id = h.object_id';
- if(defined $state) {
- $sql .= ' AND o.state = ?';
- push(@params, $state);
- }
- if(defined($name)) {
- $sql .= ' AND h.servername LIKE ?';
- push(@params, '%'.$name.'%');
- }
- if(defined($group)) {
- $sql .= ' AND o.owner_gid = ?';
- push(@params, $group->get_gid);
- }
- $sql .= " ORDER BY servername";
- $sth = $vhffs->get_db_object->prepare( $sql );
- my $rows = $sth->execute(@params);
-
- return undef unless($rows);
-
- while( $result = $sth->fetchrow_arrayref )
- {
- push @{$objs}, _new Vhffs::Services::Web($vhffs, @{$result});
- }
- return $objs;
-}
-
-sub search
-{
- my ($vhffs, $state, $name) = @_;
-
- my @params;
- my $sql = 'SELECT h.httpd_id, h.servername, o.owner_uid, o.owner_gid, h.object_id, o.date_creation, o.description, o.state FROM vhffs_httpd h INNER JOIN vhffs_object o ON o.object_id = h.object_id WHERE 1=1';
-
- if( defined $state ) {
- $sql .= ' AND o.state=?';
- push(@params, $state);
- }
-
- if( defined $name ) {
- $sql .= ' AND ( o.description ILIKE ? OR w.servername LIKE ? )';
- push(@params, '%'.$name.'%');
- push(@params, '%'.lc($name).'%');
- }
-
- $sql .= ' ORDER BY servername';
- my $sth = $vhffs->get_db_object()->prepare( $sql );
-
- my $rows = $sth->execute(@params);
-
- return undef unless($rows);
-
- my $objs;
- while( my $result = $sth->fetchrow_arrayref )
- {
- push @{$objs}, _new Vhffs::Services::Web($vhffs, @{$result});
- }
- return $objs;
-}
-
-
-=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::Web::get_by_servername($main, $servername);
- die("Webarea $servername not found\n") unless(defined $httpd);
-
-Fetches the webarea whose address is C<$servername>.
-
-=cut
-
-sub get_by_servername {
- my ($main, $servername) = @_;
- my $sql = 'SELECT h.httpd_id, h.servername, o.owner_uid, o.owner_gid, h.object_id, o.date_creation, o.description, o.state FROM vhffs_httpd h INNER JOIN vhffs_object o ON o.object_id = h.object_id WHERE h.servername = ?';
-
- my $dbh = $main->get_db_object();
- my @params;
- return undef unless(@params = $dbh->selectrow_array($sql, undef, $servername));
-
- return _new Vhffs::Services::Web($main, @params);
-}
-
-
-sub _new {
- my ($class, $main, $httpd_id, $servername, $owner_uid, $owner_gid, $oid, $date_creation, $description, $state) = @_;
-
- my $self = $class->SUPER::_new($main, $oid, $owner_uid, $owner_gid, $date_creation, $description, '', $state, Vhffs::Constants::TYPE_WEB);
- return undef unless(defined($self));
-
- $self->{http_id} = $httpd_id;
- $self->{servername} = $servername;
-
- return $self;
-}
-
-
1;
__END__
Modified: trunk/vhffs-listengine/src/listengine.pl
===================================================================
--- trunk/vhffs-listengine/src/listengine.pl 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-listengine/src/listengine.pl 2012-02-19 15:14:31 UTC (rev 2024)
@@ -376,7 +376,7 @@
Body => Vhffs::Listengine::mail_confirm_sub_approvalneeded( $list , $from )
);
- $list->change_state_for_sub( $from , Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_VALIDATION );
+ $list->change_right_for_sub( $from , Vhffs::Constants::ML_RIGHT_SUB_WAITING_FOR_VALIDATION );
my $pass = $list->set_randomhash ( $from );
sendmail( $email , $from );
@@ -411,7 +411,7 @@
Body => Vhffs::Listengine::mail_confirm_sub( $list , $from )
);
- $list->change_state_for_sub( $from , Vhffs::Constants::ML_RIGHT_SUB );
+ $list->change_right_for_sub( $from , Vhffs::Constants::ML_RIGHT_SUB );
$list->clear_hash( $from );
sendmail( $email , $from );
}
@@ -508,7 +508,7 @@
Body => Vhffs::Listengine::mail_moderate_subscription_accepted( $list , $from )
);
- $list->change_state_for_sub( $subscriber , Vhffs::Constants::ML_RIGHT_SUB );
+ $list->change_right_for_sub( $subscriber , Vhffs::Constants::ML_RIGHT_SUB );
$list->clear_hash( $subscriber );
sendmail( $email , $subscriber );
Modified: trunk/vhffs-robots/src/web_create.pl
===================================================================
--- trunk/vhffs-robots/src/web_create.pl 2012-02-19 12:27:30 UTC (rev 2023)
+++ trunk/vhffs-robots/src/web_create.pl 2012-02-19 15:14:31 UTC (rev 2024)
@@ -43,7 +43,7 @@
Vhffs::Robots::lock( $vhffs , "web" );
-my $webs = Vhffs::Services::Web::getall( $vhffs , Vhffs::Constants::WAITING_FOR_CREATION , undef, undef );
+my $webs = Vhffs::Services::Web::getall( $vhffs , Vhffs::Constants::WAITING_FOR_CREATION );
my $web;
foreach $web ( @{$webs} )