SL/DB/AuthClient.pm

   1 package SL::DB::AuthClient;
   2
   3 use strict;
   4
   5 use Carp;
   6 use File::Path ();
   7
   8 use SL::DBConnect;
   9 use SL::DB::MetaSetup::AuthClient;
  10 use SL::DB::Manager::AuthClient;
  11 use SL::DB::Helper::Util;
  12
  13 __PACKAGE__->meta->add_relationship(
  14   users => {
  15     type      => 'many to many',
  16     map_class => 'SL::DB::AuthClientUser',
  17     map_from  => 'client',
  18     map_to    => 'user',
  19   },
  20   groups => {
  21     type      => 'many to many',
  22     map_class => 'SL::DB::AuthClientGroup',
  23     map_from  => 'client',
  24     map_to    => 'group',
  25   },
  26 );
  27
  28 __PACKAGE__->meta->initialize;
  29
  30 __PACKAGE__->before_save('_before_save_remember_old_name');
  31 __PACKAGE__->after_save('_after_save_ensure_webdav_symlink_correctness');
  32 __PACKAGE__->after_delete('_after_delete_delete_webdav_symlink');
  33
  34 sub _before_save_remember_old_name {
  35   my ($self) = @_;
  36
  37   delete $self->{__before_save_remember_old_name};
  38   if ($self->id && $::lx_office_conf{features}->{webdav}) {
  39     $self->{__before_save_remember_old_name} = SL::DB::AuthClient->new(id => $self->id)->load->name;
  40   }
  41
  42   return 1;
  43 }
  44
  45 sub _after_save_ensure_webdav_symlink_correctness {
  46   my ($self) = @_;
  47
  48   $self->ensure_webdav_symlink_correctness($self->{__before_save_remember_old_name}) if $self->id && $::instance_conf->get_webdav;
  49   return 1;
  50 }
  51
  52 sub _after_delete_delete_webdav_symlink {
  53   my ($self) = @_;
  54
  55   return 1 if !$::instance_conf->get_webdav;
  56   my $name = $self->webdav_symlink_basename;
  57   unlink "webdav/links/${name}";
  58   return 1;
  59 }
  60
  61 sub validate {
  62   my ($self) = @_;
  63
  64   my @errors;
  65   push @errors, $::locale->text('The name is missing.')                                           if !$self->name;
  66   push @errors, $::locale->text('The database name is missing.')                                  if !$self->dbname;
  67   push @errors, $::locale->text('The database host is missing.')                                  if !$self->dbhost;
  68   push @errors, $::locale->text('The database port is missing.')                                  if !$self->dbport;
  69   push @errors, $::locale->text('The database user is missing.')                                  if !$self->dbuser;
  70   push @errors, $::locale->text('The name is not unique.')                                        if !SL::DB::Helper::Util::is_unique($self, 'name');
  71   push @errors, $::locale->text('The combination of database host, port and name is not unique.') if !SL::DB::Helper::Util::is_unique($self, 'dbhost', 'dbport', 'dbname');
  72
  73   return @errors;
  74 }
  75
  76 sub webdav_symlink_basename {
  77   my ($self, $name) =  @_;
  78
  79   $name             =  $name || $self->name || '';
  80   $name             =~ s:/+:_:g;
  81
  82   return $name;
  83 }
  84
  85 sub ensure_webdav_symlink_correctness {
  86   my ($self, $old_name) = @_;
  87
  88   return unless $::instance_conf->get_webdav;
  89
  90   croak "Need object ID" unless $self->id;
  91
  92   my $new_symlink = $self->webdav_symlink_basename;
  93
  94   croak "Need name" unless $new_symlink;
  95
  96   my $base_path = 'webdav/links';
  97
  98   if ($old_name) {
  99     my $old_symlink = $self->webdav_symlink_basename($old_name);
 100     return if $old_symlink eq $new_symlink;
 101
 102     if (-l "${base_path}/${old_symlink}") {
 103       rename "${base_path}/${old_symlink}", "${base_path}/${new_symlink}";
 104       return;
 105     }
 106   }
 107
 108   File::Path::make_path('webdav/' . $self->id);
 109   symlink '../' . $self->id, "${base_path}/${new_symlink}";
 110 }
 111
 112 sub get_dbconnect_args {
 113   my ($self, %params) = @_;
 114
 115   return (
 116     'dbi:Pg:dbname=' . $self->dbname . ';host=' . ($self->dbhost || 'localhost') . ';port=' . ($self->dbport || 5432),
 117     $self->dbuser,
 118     $self->dbpasswd,
 119     SL::DBConnect->get_options(%params),
 120   );
 121 }
 122
 123 sub dbconnect {
 124   my ($self, %params) = @_;
 125   return SL::DBConnect->connect($self->get_dbconnect_args(%params));
 126 }
 127
 128 1;
 129 __END__
 130
 131 =pod
 132
 133 =encoding utf8
 134
 135 =head1 NAME
 136
 137 SL::DB::AuthClient - RDBO model for the auth.clients table
 138
 139 =head1 FUNCTIONS
 140
 141 =over 4
 142
 143 =item C<dbconnect [%params]>
 144
 145 Establishes a new database connection to the database configured for
 146 C<$self>. Returns a database handle as returned by
 147 L<SL::DBConnect/connect> (which is either a normal L<DBI> handle or
 148 one handled by L<DBIx::Log4perl>).
 149
 150 C<%params> are optional parameters passed as the fourth argument to
 151 L<SL::DBConnect/connect>. They're first filtered through
 152 L<SL::DBConnect/get_options> so the UTF-8 flag will be set properly.
 153
 154 =item C<ensure_webdav_symlink_correctness>
 155
 156 Handles the symlink creation/deletion for the WebDAV folder. Does
 157 nothing if WebDAV is not enabled in the configuration.
 158
 159 For each existing client a symbolic link should exist in the directory
 160 C<webdav/links> pointing to the actual WebDAV directory which is the
 161 client's database ID.
 162
 163 The symbolic link's name is the client's name sanitized a bit. It's
 164 calculated by L</webdav_symlink_basename>.
 165
 166 =item C<get_dbconnect_args [%params]>
 167
 168 Returns an array of database connection parameters suitable for
 169 passing to L<SL::DBConnect/connect>.
 170
 171 C<%params> are optional parameters passed as the fourth argument to
 172 L<SL::DBConnect/connect>. They're first filtered through
 173 L<SL::DBConnect/get_options> so the UTF-8 flag will be set properly.
 174
 175 =item C<validate>
 176
 177 Returns an array of human-readable error message if the object must
 178 not be saved and an empty list if nothing's wrong.
 179
 180 =item C<webdav_symlink_basename>
 181
 182 Returns the base name of the symbolic link for the WebDAV C<links>
 183 sub-folder.
 184
 185 =back
 186
 187 =head1 BUGS
 188
 189 Nothing here yet.
 190
 191 =head1 AUTHOR
 192
 193 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 194
 195 =cut