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         use RT::User;
 108         my $user = RT::User->new($self);
 109
 110         unless ($user->Load($self->Id)) {
 111             $RT::Logger->err($self->loc("Couldn't load [_1] from the users database.\n", $self->Id));
 112         }
 113     return ($user);
 114 }
 115 # }}}
 116
 117 # {{{ sub PrincipalObj
 118
 119 =head2 PrincipalObj
 120
 121     Returns this user's principal object.  this is just a helper routine for
 122     $self->UserObj->PrincipalObj
 123
 124 =cut
 125
 126 sub PrincipalObj {
 127     my $self = shift;
 128     return($self->UserObj->PrincipalObj);
 129 }
 130
 131
 132 # }}}
 133
 134
 135 # {{{ sub PrincipalId
 136
 137 =head2 PrincipalId
 138
 139     Returns this user's principal Id.  this is just a helper routine for
 140     $self->UserObj->PrincipalId
 141
 142 =cut
 143
 144 sub PrincipalId {
 145     my $self = shift;
 146     return($self->UserObj->PrincipalId);
 147 }
 148
 149
 150 # }}}
 151
 152
 153 # {{{ sub _Accessible
 154 sub _Accessible  {
 155   my $self = shift;
 156   my %Cols = (
 157               Name => 'read',
 158               Gecos => 'read',
 159               RealName => 'read',
 160               Password => 'neither',
 161           Lang => 'read',
 162               EmailAddress => 'read',
 163               Privileged => 'read',
 164               IsAdministrator => 'read'
 165              );
 166   return($self->SUPER::_Accessible(@_, %Cols));
 167 }
 168 # }}}
 169
 170 # {{{ sub LoadByEmail
 171
 172 =head2 LoadByEmail
 173
 174 Loads a User into this CurrentUser object.
 175 Takes the email address of the user to load.
 176
 177 =cut
 178
 179 sub LoadByEmail  {
 180     my $self = shift;
 181     my $identifier = shift;
 182
 183     $identifier = RT::User::CanonicalizeEmailAddress(undef, $identifier);
 184
 185     $self->LoadByCol("EmailAddress",$identifier);
 186
 187 }
 188 # }}}
 189
 190 # {{{ sub LoadByGecos
 191
 192 =head2 LoadByGecos
 193
 194 Loads a User into this CurrentUser object.
 195 Takes a unix username as its only argument.
 196
 197 =cut
 198
 199 sub LoadByGecos  {
 200     my $self = shift;
 201     my $identifier = shift;
 202
 203     $self->LoadByCol("Gecos",$identifier);
 204
 205 }
 206 # }}}
 207
 208 # {{{ sub LoadByName
 209
 210 =head2 LoadByName
 211
 212 Loads a User into this CurrentUser object.
 213 Takes a Name.
 214 =cut
 215
 216 sub LoadByName {
 217     my $self = shift;
 218     my $identifier = shift;
 219     $self->LoadByCol("Name",$identifier);
 220
 221 }
 222 # }}}
 223
 224 # {{{ sub Load
 225
 226 =head2 Load
 227
 228 Loads a User into this CurrentUser object.
 229 Takes either an integer (users id column reference) or a Name
 230 The latter is deprecated. Instead, you should use LoadByName.
 231 Formerly, this routine also took email addresses.
 232
 233 =cut
 234
 235 sub Load  {
 236   my $self = shift;
 237   my $identifier = shift;
 238
 239   #if it's an int, load by id. otherwise, load by name.
 240   if ($identifier !~ /\D/) {
 241     $self->SUPER::LoadById($identifier);
 242   }
 243
 244   elsif (UNIVERSAL::isa($identifier,"RT::User")) {
 245          # DWIM if they pass a user in
 246          $self->SUPER::LoadById($identifier->Id);
 247   }
 248   else {
 249       # This is a bit dangerous, we might get false authen if somebody
 250       # uses ambigous userids or real names:
 251       $self->LoadByCol("Name",$identifier);
 252   }
 253 }
 254
 255 # }}}
 256
 257 # {{{ sub IsPassword
 258
 259 =head2 IsPassword
 260
 261 Takes a password as a string.  Passes it off to IsPassword in this
 262 user's UserObj.  If it is the user's password and the user isn't
 263 disabled, returns 1.
 264
 265 Otherwise, returns undef.
 266
 267 =cut
 268
 269 sub IsPassword {
 270   my $self = shift;
 271   my $value = shift;
 272
 273   return ($self->UserObj->IsPassword($value));
 274 }
 275
 276 # }}}
 277
 278 # {{{ sub Privileged
 279
 280 =head2 Privileged
 281
 282 Returns true if the current user can be granted rights and be
 283 a member of groups.
 284
 285 =cut
 286
 287 sub Privileged {
 288     my $self = shift;
 289     return ($self->UserObj->Privileged());
 290 }
 291
 292 # }}}
 293
 294
 295 # {{{ sub HasRight
 296
 297 =head2 HasRight
 298
 299 calls $self->UserObj->HasRight with the arguments passed in
 300
 301 =cut
 302
 303 sub HasRight {
 304   my $self = shift;
 305   return ($self->UserObj->HasRight(@_));
 306 }
 307
 308 # }}}
 309
 310 # {{{ Localization
 311
 312 =head2 LanguageHandle
 313
 314 Returns this current user's langauge handle. Should take a language
 315 specification. but currently doesn't
 316
 317 =begin testing
 318
 319 ok (my $cu = RT::CurrentUser->new('root'));
 320 ok (my $lh = $cu->LanguageHandle);
 321 ok ($lh != undef);
 322 ok ($lh->isa('Locale::Maketext'));
 323 ok ($cu->loc('TEST_STRING') eq "Concrete Mixer", "Localized TEST_STRING into English");
 324 ok ($lh = $cu->LanguageHandle('fr'));
 325 ok ($cu->loc('Before') eq "Avant", "Localized TEST_STRING into Frenc");
 326
 327 =end testing
 328
 329 =cut
 330
 331 sub LanguageHandle {
 332     my $self = shift;
 333     if  ((!defined $self->{'LangHandle'}) ||
 334          (!UNIVERSAL::can($self->{'LangHandle'}, 'maketext')) ||
 335          (@_))  {
 336         if ( $self->Lang) {
 337             push @_, $self->Lang;
 338         }
 339         $self->{'LangHandle'} = RT::I18N->get_handle(@_);
 340     }
 341     # Fall back to english.
 342     unless ($self->{'LangHandle'}) {
 343         die "We couldn't get a dictionary. Nye mogu naidti slovar. No puedo encontrar dictionario.";
 344     }
 345     return ($self->{'LangHandle'});
 346 }
 347
 348 sub loc {
 349     my $self = shift;
 350     return '' if $_[0] eq '';
 351
 352     my $handle = $self->LanguageHandle;
 353
 354     if (@_ == 1) {
 355         # pre-scan the lexicon hashes to return _AUTO keys verbatim,
 356         # to keep locstrings containing '[' and '~' from tripping over Maketext
 357         return $_[0] unless grep { exists $_->{$_[0]} } @{ $handle->_lex_refs };
 358     }
 359
 360     return $handle->maketext(@_);
 361 }
 362
 363 sub loc_fuzzy {
 364     my $self = shift;
 365     return '' if $_[0] eq '';
 366
 367     # XXX: work around perl's deficiency when matching utf8 data
 368     return $_[0] if Encode::is_utf8($_[0]);
 369     my $result = $self->LanguageHandle->maketext_fuzzy(@_);
 370
 371     return($result);
 372 }
 373 # }}}
 374
 375
 376 =head2 CurrentUser
 377
 378 Return  the current currentuser object
 379
 380 =cut
 381
 382 sub CurrentUser  {
 383     my $self = shift;
 384     return($self);
 385
 386 }
 387
 388 eval "require RT::CurrentUser_Vendor";
 389 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Vendor.pm});
 390 eval "require RT::CurrentUser_Local";
 391 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Local.pm});
 392
 393 1;
 394