rt/lib/RT/CurrentUser.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   7 # This work is made available to you under the terms of Version 2 of
   8 # the GNU General Public License. A copy of that license should have
   9 # been provided with this software, but in any event can be snarfed
  10 # from www.gnu.org.
  11 #
  12 # This work is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # Unless otherwise specified, all modifications, corrections or
  18 # extensions to this work which alter its source code become the
  19 # property of Best Practical Solutions, LLC when submitted for
  20 # inclusion in the work.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 =head1 NAME
  25
  26   RT::CurrentUser - an RT object representing the current user
  27
  28 =head1 SYNOPSIS
  29
  30   use RT::CurrentUser
  31
  32
  33 =head1 DESCRIPTION
  34
  35
  36 =head1 METHODS
  37
  38
  39 =begin testing
  40
  41 ok (require RT::CurrentUser);
  42
  43 =end testing
  44
  45 =cut
  46
  47
  48 package RT::CurrentUser;
  49
  50 use RT::Record;
  51 use RT::I18N;
  52
  53 use strict;
  54 use vars qw/@ISA/;
  55 @ISA= qw(RT::Record);
  56
  57 # {{{ sub _Init
  58
  59 #The basic idea here is that $self->CurrentUser is always supposed
  60 # to be a CurrentUser object. but that's hard to do when we're trying to load
  61 # the CurrentUser object
  62
  63 sub _Init  {
  64   my $self = shift;
  65   my $Name = shift;
  66
  67   $self->{'table'} = "Users";
  68
  69   if (defined($Name)) {
  70     $self->Load($Name);
  71   }
  72
  73   $self->CurrentUser($self);
  74
  75 }
  76 # }}}
  77
  78 # {{{ sub Create
  79
  80 sub Create {
  81     my $self = shift;
  82     return (0, $self->loc('Permission Denied'));
  83 }
  84
  85 # }}}
  86
  87 # {{{ sub Delete
  88
  89 sub Delete {
  90     my $self = shift;
  91     return (0, $self->loc('Permission Denied'));
  92 }
  93
  94 # }}}
  95
  96 # {{{ sub UserObj
  97
  98 =head2 UserObj
  99
 100   Returns the RT::User object associated with this CurrentUser object.
 101
 102 =cut
 103
 104 sub UserObj {
 105     my $self = shift;
 106
 107     unless ($self->{'UserObj'}) {
 108         use RT::User;
 109         $self->{'UserObj'} = RT::User->new($self);
 110         unless ($self->{'UserObj'}->Load($self->Id)) {
 111             $RT::Logger->err($self->loc("Couldn't load [_1] from the users database.\n", $self->Id));
 112         }
 113
 114     }
 115     return ($self->{'UserObj'});
 116 }
 117 # }}}
 118
 119 # {{{ sub PrincipalObj
 120
 121 =head2 PrincipalObj
 122
 123     Returns this user's principal object.  this is just a helper routine for
 124     $self->UserObj->PrincipalObj
 125
 126 =cut
 127
 128 sub PrincipalObj {
 129     my $self = shift;
 130     return($self->UserObj->PrincipalObj);
 131 }
 132
 133
 134 # }}}
 135
 136
 137 # {{{ sub PrincipalId
 138
 139 =head2 PrincipalId
 140
 141     Returns this user's principal Id.  this is just a helper routine for
 142     $self->UserObj->PrincipalId
 143
 144 =cut
 145
 146 sub PrincipalId {
 147     my $self = shift;
 148     return($self->UserObj->PrincipalId);
 149 }
 150
 151
 152 # }}}
 153
 154
 155 # {{{ sub _Accessible
 156 sub _Accessible  {
 157   my $self = shift;
 158   my %Cols = (
 159               Name => 'read',
 160               Gecos => 'read',
 161               RealName => 'read',
 162               Password => 'neither',
 163               EmailAddress => 'read',
 164               Privileged => 'read',
 165               IsAdministrator => 'read'
 166              );
 167   return($self->SUPER::_Accessible(@_, %Cols));
 168 }
 169 # }}}
 170
 171 # {{{ sub LoadByEmail
 172
 173 =head2 LoadByEmail
 174
 175 Loads a User into this CurrentUser object.
 176 Takes the email address of the user to load.
 177
 178 =cut
 179
 180 sub LoadByEmail  {
 181     my $self = shift;
 182     my $identifier = shift;
 183
 184     $identifier = RT::User::CanonicalizeEmailAddress(undef, $identifier);
 185
 186     $self->LoadByCol("EmailAddress",$identifier);
 187
 188 }
 189 # }}}
 190
 191 # {{{ sub LoadByGecos
 192
 193 =head2 LoadByGecos
 194
 195 Loads a User into this CurrentUser object.
 196 Takes a unix username as its only argument.
 197
 198 =cut
 199
 200 sub LoadByGecos  {
 201     my $self = shift;
 202     my $identifier = shift;
 203
 204     $self->LoadByCol("Gecos",$identifier);
 205
 206 }
 207 # }}}
 208
 209 # {{{ sub LoadByName
 210
 211 =head2 LoadByName
 212
 213 Loads a User into this CurrentUser object.
 214 Takes a Name.
 215 =cut
 216
 217 sub LoadByName {
 218     my $self = shift;
 219     my $identifier = shift;
 220     $self->LoadByCol("Name",$identifier);
 221
 222 }
 223 # }}}
 224
 225 # {{{ sub Load
 226
 227 =head2 Load
 228
 229 Loads a User into this CurrentUser object.
 230 Takes either an integer (users id column reference) or a Name
 231 The latter is deprecated. Instead, you should use LoadByName.
 232 Formerly, this routine also took email addresses.
 233
 234 =cut
 235
 236 sub Load  {
 237   my $self = shift;
 238   my $identifier = shift;
 239
 240   #if it's an int, load by id. otherwise, load by name.
 241   if ($identifier !~ /\D/) {
 242     $self->SUPER::LoadById($identifier);
 243   }
 244   else {
 245       # This is a bit dangerous, we might get false authen if somebody
 246       # uses ambigous userids or real names:
 247       $self->LoadByCol("Name",$identifier);
 248   }
 249 }
 250
 251 # }}}
 252
 253 # {{{ sub IsPassword
 254
 255 =head2 IsPassword
 256
 257 Takes a password as a string.  Passes it off to IsPassword in this
 258 user's UserObj.  If it is the user's password and the user isn't
 259 disabled, returns 1.
 260
 261 Otherwise, returns undef.
 262
 263 =cut
 264
 265 sub IsPassword {
 266   my $self = shift;
 267   my $value = shift;
 268
 269   return ($self->UserObj->IsPassword($value));
 270 }
 271
 272 # }}}
 273
 274 # {{{ sub Privileged
 275
 276 =head2 Privileged
 277
 278 Returns true if the current user can be granted rights and be
 279 a member of groups.
 280
 281 =cut
 282
 283 sub Privileged {
 284     my $self = shift;
 285     return ($self->UserObj->Privileged());
 286 }
 287
 288 # }}}
 289
 290
 291 # {{{ sub HasRight
 292
 293 =head2 HasRight
 294
 295 calls $self->UserObj->HasRight with the arguments passed in
 296
 297 =cut
 298
 299 sub HasRight {
 300   my $self = shift;
 301   return ($self->UserObj->HasRight(@_));
 302 }
 303
 304 # }}}
 305
 306 # {{{ Localization
 307
 308 =head2 LanguageHandle
 309
 310 Returns this current user's langauge handle. Should take a language
 311 specification. but currently doesn't
 312
 313 =begin testing
 314
 315 ok (my $cu = RT::CurrentUser->new('root'));
 316 ok (my $lh = $cu->LanguageHandle);
 317 ok ($lh != undef);
 318 ok ($lh->isa('Locale::Maketext'));
 319 ok ($cu->loc('TEST_STRING') eq "Concrete Mixer", "Localized TEST_STRING into English");
 320 ok ($lh = $cu->LanguageHandle('fr'));
 321 ok ($cu->loc('Before') eq "Avant", "Localized TEST_STRING into Frenc");
 322
 323 =end testing
 324
 325 =cut
 326
 327 sub LanguageHandle {
 328     my $self = shift;
 329     if  ((!defined $self->{'LangHandle'}) ||
 330          (!UNIVERSAL::can($self->{'LangHandle'}, 'maketext')) ||
 331          (@_))  {
 332         $self->{'LangHandle'} = RT::I18N->get_handle(@_);
 333     }
 334     # Fall back to english.
 335     unless ($self->{'LangHandle'}) {
 336         die "We couldn't get a dictionary. Nye mogu naidti slovar. No puedo encontrar dictionario.";
 337     }
 338     return ($self->{'LangHandle'});
 339 }
 340
 341 sub loc {
 342     my $self = shift;
 343     return '' if $_[0] eq '';
 344
 345     my $handle = $self->LanguageHandle;
 346
 347     if (@_ == 1) {
 348         # pre-scan the lexicon hashes to return _AUTO keys verbatim,
 349         # to keep locstrings containing '[' and '~' from tripping over Maketext
 350         return $_[0] unless grep { exists $_->{$_[0]} } @{ $handle->_lex_refs };
 351     }
 352
 353     return $handle->maketext(@_);
 354 }
 355
 356 sub loc_fuzzy {
 357     my $self = shift;
 358     return '' if $_[0] eq '';
 359
 360     # XXX: work around perl's deficiency when matching utf8 data
 361     return $_[0] if Encode::is_utf8($_[0]);
 362     my $result = $self->LanguageHandle->maketext_fuzzy(@_);
 363
 364     return($result);
 365 }
 366 # }}}
 367
 368 eval "require RT::CurrentUser_Vendor";
 369 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Vendor.pm});
 370 eval "require RT::CurrentUser_Local";
 371 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Local.pm});
 372
 373 1;
 374