"Fossies" - the Fresh Open Source Software Archive

Member "RT-Extension-Assets-1.05/lib/RT/Asset.pm" (1 Apr 2015, 16764 Bytes) of package /linux/misc/RT-Extension-Assets-1.05.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Asset.pm" see the Fossies "Dox" file reference documentation.

    1 # BEGIN BPS TAGGED BLOCK {{{
    2 #
    3 # COPYRIGHT:
    4 #
    5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
    6 #                                          <sales@bestpractical.com>
    7 #
    8 # (Except where explicitly superseded by other copyright notices)
    9 #
   10 #
   11 # LICENSE:
   12 #
   13 # This work is made available to you under the terms of Version 2 of
   14 # the GNU General Public License. A copy of that license should have
   15 # been provided with this software, but in any event can be snarfed
   16 # from www.gnu.org.
   17 #
   18 # This work is distributed in the hope that it will be useful, but
   19 # WITHOUT ANY WARRANTY; without even the implied warranty of
   20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   21 # General Public License for more details.
   22 #
   23 # You should have received a copy of the GNU General Public License
   24 # along with this program; if not, write to the Free Software
   25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
   26 # 02110-1301 or visit their web page on the internet at
   27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
   28 #
   29 #
   30 # CONTRIBUTION SUBMISSION POLICY:
   31 #
   32 # (The following paragraph is not intended to limit the rights granted
   33 # to you to modify and distribute this software under the terms of
   34 # the GNU General Public License and is only of importance to you if
   35 # you choose to contribute your changes and enhancements to the
   36 # community by submitting them to Best Practical Solutions, LLC.)
   37 #
   38 # By intentionally submitting any modifications, corrections or
   39 # derivatives to this work, or any other work intended for use with
   40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
   41 # you are the copyright holder for those contributions and you grant
   42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
   43 # royalty-free, perpetual, license to use, copy, create derivative
   44 # works based on those contributions, and sublicense and distribute
   45 # those contributions and any derivatives thereof.
   46 #
   47 # END BPS TAGGED BLOCK }}}
   48 
   49 use strict;
   50 use warnings;
   51 use 5.10.1;
   52 
   53 package RT::Asset;
   54 use base 'RT::Record';
   55 
   56 use Role::Basic "with";
   57 with "RT::Record::Role::Status",
   58      "RT::Record::Role::Links",
   59      "RT::Record::Role::Roles" => {
   60          -rename => {
   61              # We provide ACL'd wraps of these.
   62              AddRoleMember    => "_AddRoleMember",
   63              DeleteRoleMember => "_DeleteRoleMember",
   64              RoleGroup        => "_RoleGroup",
   65          },
   66      };
   67 
   68 require RT::Catalog;
   69 require RT::CustomField;
   70 require RT::URI::asset;
   71 
   72 =head1 NAME
   73 
   74 RT::Asset - Represents a single asset record
   75 
   76 =cut
   77 
   78 sub LifecycleColumn { "Catalog" }
   79 
   80 # Assets are primarily built on custom fields
   81 RT::CustomField->RegisterLookupType( CustomFieldLookupType() => 'Assets' );
   82 RT::CustomField->RegisterBuiltInGroupings(
   83     'RT::Asset' => [qw( Basics Dates People Links )]
   84 );
   85 
   86 # loc('Owner')
   87 # loc('HeldBy')
   88 # loc('Contact')
   89 for my $role ('Owner', 'HeldBy', 'Contact') {
   90     state $i = 1;
   91     RT::Asset->RegisterRole(
   92         Name            => $role,
   93         EquivClasses    => ["RT::Catalog"],
   94         SortOrder       => $i++,
   95         ( $role eq "Owner"
   96             ? ( Single         => 1,
   97                 ACLOnlyInEquiv => 1, )
   98             : () ),
   99     );
  100 }
  101 
  102 =head1 DESCRIPTION
  103 
  104 An Asset is a small record object upon which zero to many custom fields are
  105 applied.  The core fields are:
  106 
  107 =over 4
  108 
  109 =item id
  110 
  111 =item Name
  112 
  113 Limited to 255 characters.
  114 
  115 =item Description
  116 
  117 Limited to 255 characters.
  118 
  119 =item Catalog
  120 
  121 =item Status
  122 
  123 =item Creator
  124 
  125 =item Created
  126 
  127 =item LastUpdatedBy
  128 
  129 =item LastUpdated
  130 
  131 =back
  132 
  133 All of these are readable through methods of the same name and mutable through
  134 methods of the same name with C<Set> prefixed.  The last four are automatically
  135 managed.
  136 
  137 =head1 METHODS
  138 
  139 =head2 Load ID or NAME
  140 
  141 Loads the specified Asset into the current object.
  142 
  143 =cut
  144 
  145 sub Load {
  146     my $self = shift;
  147     my $id   = shift;
  148     return unless $id;
  149 
  150     if ( $id =~ /\D/ ) {
  151         return $self->LoadByCols( Name => $id );
  152     }
  153     else {
  154         return $self->SUPER::Load($id);
  155     }
  156 }
  157 
  158 =head2 Create PARAMHASH
  159 
  160 Create takes a hash of values and creates a row in the database.  Available keys are:
  161 
  162 =over 4
  163 
  164 =item Name
  165 
  166 =item Description
  167 
  168 =item Catalog
  169 
  170 Name or numeric ID
  171 
  172 =item CustomField-<ID>
  173 
  174 Sets the value for this asset of the custom field specified by C<< <ID> >>.
  175 
  176 C<< <ID> >> should be a numeric ID, but may also be a Name if and only if your
  177 custom fields have unique names.  Without unique names, the behaviour is
  178 undefined.
  179 
  180 =item Status
  181 
  182 =item Owner, HeldBy, Contact
  183 
  184 A single principal ID or array ref of principal IDs to add as members of the
  185 respective role groups for the new asset.
  186 
  187 User Names and EmailAddresses may also be used, but Groups must be referenced
  188 by ID.
  189 
  190 =item RefersTo, ReferredToBy, DependsOn, DependedOnBy, Parents, Children, and aliases
  191 
  192 Any of these link types accept either a single value or arrayref of values
  193 parseable by L<RT::URI>.
  194 
  195 =back
  196 
  197 Returns a tuple of (status, msg) on failure and (id, msg, non-fatal errors) on
  198 success, where the third value is an array reference of errors that occurred
  199 but didn't prevent creation.
  200 
  201 =cut
  202 
  203 sub Create {
  204     my $self = shift;
  205     my %args = (
  206         Name            => '',
  207         Description     => '',
  208         Catalog         => undef,
  209 
  210         Owner           => undef,
  211         HeldBy          => undef,
  212         Contact         => undef,
  213 
  214         Status          => undef,
  215         @_
  216     );
  217     my @non_fatal_errors;
  218 
  219     return (0, $self->loc("Invalid Catalog"))
  220         unless $self->ValidateCatalog( $args{'Catalog'} );
  221 
  222     my $catalog = RT::Catalog->new( $self->CurrentUser );
  223     $catalog->Load($args{'Catalog'});
  224 
  225     $args{'Catalog'} = $catalog->id;
  226 
  227     return (0, $self->loc("Permission Denied"))
  228         unless $catalog->CurrentUserHasRight('CreateAsset');
  229 
  230     return (0, $self->loc('Invalid Name (names may not be all digits)'))
  231         unless $self->ValidateName( $args{'Name'} );
  232 
  233     # XXX TODO: This status/lifecycle pattern is duplicated in RT::Ticket and
  234     # should be refactored into a role helper.
  235     my $cycle = $catalog->LifecycleObj;
  236     unless ( defined $args{'Status'} && length $args{'Status'} ) {
  237         $args{'Status'} = $cycle->DefaultOnCreate;
  238     }
  239 
  240     $args{'Status'} = lc $args{'Status'};
  241     unless ( $cycle->IsValid( $args{'Status'} ) ) {
  242         return ( 0,
  243             $self->loc("Status '[_1]' isn't a valid status for assets.",
  244                 $self->loc($args{'Status'}))
  245         );
  246     }
  247 
  248     unless ( $cycle->IsTransition( '' => $args{'Status'} ) ) {
  249         return ( 0,
  250             $self->loc("New assets cannot have status '[_1]'.",
  251                 $self->loc($args{'Status'}))
  252         );
  253     }
  254 
  255     my $roles = {};
  256     my @errors = $self->_ResolveRoles( $roles, %args );
  257     return (0, @errors) if @errors;
  258 
  259     RT->DatabaseHandle->BeginTransaction();
  260 
  261     my ( $id, $msg ) = $self->SUPER::Create(
  262         map { $_ => $args{$_} } grep {exists $args{$_}}
  263             qw(id Name Description Catalog Status),
  264     );
  265     unless ($id) {
  266         RT->DatabaseHandle->Rollback();
  267         return (0, $self->loc("Asset create failed: [_1]", $msg));
  268     }
  269 
  270     # Let users who just created an asset see it until the end of this method.
  271     $self->{_object_is_readable} = 1;
  272 
  273     # Create role groups
  274     unless ($self->_CreateRoleGroups()) {
  275         RT->Logger->error("Couldn't create role groups for asset ". $self->id);
  276         RT->DatabaseHandle->Rollback();
  277         return (0, $self->loc("Couldn't create role groups for asset"));
  278     }
  279 
  280     # Figure out users for roles
  281     push @non_fatal_errors, $self->_AddRolesOnCreate( $roles, map { $_ => sub {1} } $self->Roles );
  282 
  283     # Add CFs
  284     foreach my $key (keys %args) {
  285         next unless $key =~ /^CustomField-(.+)$/i;
  286         my $cf   = $1;
  287         my @vals = ref $args{$key} eq 'ARRAY' ? @{ $args{$key} } : $args{$key};
  288         foreach my $value (@vals) {
  289             next unless defined $value;
  290 
  291             my ( $cfid, $cfmsg ) = $self->AddCustomFieldValue(
  292                 (ref($value) eq 'HASH'
  293                     ? %$value
  294                     : (Value => $value)),
  295                 Field             => $cf,
  296                 RecordTransaction => 0
  297             );
  298             unless ($cfid) {
  299                 RT->DatabaseHandle->Rollback();
  300                 return (0, $self->loc("Couldn't add custom field value on create: [_1]", $cfmsg));
  301             }
  302         }
  303     }
  304 
  305     # Create transaction
  306     my ( $txn_id, $txn_msg, $txn ) = $self->_NewTransaction( Type => 'Create' );
  307     unless ($txn_id) {
  308         RT->DatabaseHandle->Rollback();
  309         return (0, $self->loc( 'Asset Create txn failed: [_1]', $txn_msg ));
  310     }
  311 
  312     # Add links
  313     push @non_fatal_errors, $self->_AddLinksOnCreate(\%args);
  314 
  315     RT->DatabaseHandle->Commit();
  316 
  317     # Let normal ACLs take over.
  318     delete $self->{_object_is_readable};
  319 
  320     return ($id, $self->loc('Asset #[_1] created: [_2]', $self->id, $args{'Name'}), \@non_fatal_errors);
  321 }
  322 
  323 =head2 ValidateName NAME
  324 
  325 Requires that Names contain at least one non-digit.  Empty names are OK.
  326 
  327 =cut
  328 
  329 sub ValidateName {
  330     my $self = shift;
  331     my $name = shift;
  332     return 1 unless defined $name and length $name;
  333     return 0 unless $name =~ /\D/;
  334     return 1;
  335 }
  336 
  337 =head2 ValidateCatalog
  338 
  339 Takes a catalog name or ID.  Returns true if the catalog exists and is not
  340 disabled, otherwise false.
  341 
  342 =cut
  343 
  344 sub ValidateCatalog {
  345     my $self    = shift;
  346     my $name    = shift;
  347     my $catalog = RT::Catalog->new( $self->CurrentUser );
  348     $catalog->Load($name);
  349     return 1 if $catalog->id and not $catalog->Disabled;
  350     return 0;
  351 }
  352 
  353 =head2 Delete
  354 
  355 Assets may not be deleted.  Always returns failure.
  356 
  357 You should disable the asset instead with C<< $asset->SetStatus('deleted') >>.
  358 
  359 =cut
  360 
  361 sub Delete {
  362     my $self = shift;
  363     return (0, $self->loc("Assets may not be deleted"));
  364 }
  365 
  366 =head2 CurrentUserHasRight RIGHTNAME
  367 
  368 Returns true if the current user has the right for this asset, or globally if
  369 this is called on an unloaded object.
  370 
  371 =cut
  372 
  373 sub CurrentUserHasRight {
  374     my $self  = shift;
  375     my $right = shift;
  376 
  377     return (
  378         $self->CurrentUser->HasRight(
  379             Right        => $right,
  380             Object       => ($self->id ? $self : RT->System),
  381         )
  382     );
  383 }
  384 
  385 =head2 CurrentUserCanSee
  386 
  387 Returns true if the current user can see the asset, either because they just
  388 created it or they have the I<ShowAsset> right.
  389 
  390 =cut
  391 
  392 sub CurrentUserCanSee {
  393     my $self = shift;
  394     return $self->{_object_is_readable} || $self->CurrentUserHasRight('ShowAsset');
  395 }
  396 
  397 =head2 URI
  398 
  399 Returns this asset's URI
  400 
  401 =cut
  402 
  403 sub URI {
  404     my $self = shift;
  405     my $uri = RT::URI::asset->new($self->CurrentUser);
  406     return $uri->URIForObject($self);
  407 }
  408 
  409 =head2 CatalogObj
  410 
  411 Returns the L<RT::Catalog> object for this asset's catalog.
  412 
  413 =cut
  414 
  415 sub CatalogObj {
  416     my $self = shift;
  417     my $catalog = RT::Catalog->new($self->CurrentUser);
  418     $catalog->Load( $self->__Value("Catalog") );
  419     return $catalog;
  420 }
  421 
  422 =head2 SetCatalog
  423 
  424 Validates the supplied catalog and updates the column if valid.  Transitions
  425 Status if necessary.  Returns a (status, message) tuple.
  426 
  427 =cut
  428 
  429 sub SetCatalog {
  430     my $self  = shift;
  431     my $value = shift;
  432 
  433     return (0, $self->loc("Permission Denied"))
  434         unless $self->CurrentUserHasRight("ModifyAsset");
  435 
  436     my ($ok, $msg, $status) = $self->_SetLifecycleColumn(
  437         Value           => $value,
  438         RequireRight    => "CreateAsset"
  439     );
  440     return ($ok, $msg);
  441 }
  442 
  443 
  444 =head2 Owner
  445 
  446 Returns an L<RT::User> object for this asset's I<Owner> role group.  On error,
  447 returns undef.
  448 
  449 =head2 HeldBy
  450 
  451 Returns an L<RT::Group> object for this asset's I<HeldBy> role group.  The object
  452 may be unloaded if permissions aren't satisfied.
  453 
  454 =head2 Contacts
  455 
  456 Returns an L<RT::Group> object for this asset's I<Contact> role
  457 group.  The object may be unloaded if permissions aren't satisfied.
  458 
  459 =cut
  460 
  461 sub Owner {
  462     my $self  = shift;
  463     my $group = $self->RoleGroup("Owner");
  464     return unless $group and $group->id;
  465     return $group->UserMembersObj->First;
  466 }
  467 sub HeldBy   { $_[0]->RoleGroup("HeldBy")  }
  468 sub Contacts { $_[0]->RoleGroup("Contact") }
  469 
  470 =head2 AddRoleMember
  471 
  472 Checks I<ModifyAsset> before calling L<RT::Record::Role::Roles/_AddRoleMember>.
  473 
  474 =cut
  475 
  476 sub AddRoleMember {
  477     my $self = shift;
  478 
  479     return (0, $self->loc("No permission to modify this asset"))
  480         unless $self->CurrentUserHasRight("ModifyAsset");
  481 
  482     return $self->_AddRoleMember(@_);
  483 }
  484 
  485 =head2 DeleteRoleMember
  486 
  487 Checks I<ModifyAsset> before calling L<RT::Record::Role::Roles/_DeleteRoleMember>.
  488 
  489 =cut
  490 
  491 sub DeleteRoleMember {
  492     my $self = shift;
  493 
  494     return (0, $self->loc("No permission to modify this asset"))
  495         unless $self->CurrentUserHasRight("ModifyAsset");
  496 
  497     return $self->_DeleteRoleMember(@_);
  498 }
  499 
  500 =head2 RoleGroup
  501 
  502 An ACL'd version of L<RT::Record::Role::Roles/_RoleGroup>.  Checks I<ShowAsset>.
  503 
  504 =cut
  505 
  506 sub RoleGroup {
  507     my $self = shift;
  508     if ($self->CurrentUserCanSee) {
  509         return $self->_RoleGroup(@_);
  510     } else {
  511         return RT::Group->new( $self->CurrentUser );
  512     }
  513 }
  514 
  515 =head1 INTERNAL METHODS
  516 
  517 Public methods, but you shouldn't need to call these unless you're
  518 extending Assets.
  519 
  520 =head2 CustomFieldLookupType
  521 
  522 =cut
  523 
  524 sub CustomFieldLookupType { "RT::Catalog-RT::Asset" }
  525 
  526 =head2 ACLEquivalenceObjects
  527 
  528 =cut
  529 
  530 sub ACLEquivalenceObjects {
  531     my $self = shift;
  532     return $self->CatalogObj;
  533 }
  534 
  535 =head2 ModifyLinkRight
  536 
  537 =cut
  538 
  539 # Used for StrictLinkACL and RT::Record::Role::Links.
  540 #
  541 # Historically StrictLinkACL has only applied between tickets, but
  542 # if you care about it enough to turn it on, you probably care when
  543 # linking an asset to an asset or an asset to a ticket.
  544 
  545 sub ModifyLinkRight { "ShowAsset" }
  546 
  547 =head2 LoadCustomFieldByIdentifier
  548 
  549 Finds and returns the custom field of the given name for the asset,
  550 overriding L<RT::Record/LoadCustomFieldByIdentifier> to look for
  551 catalog-specific CFs before global ones.
  552 
  553 =cut
  554 
  555 sub LoadCustomFieldByIdentifier {
  556     my $self  = shift;
  557     my $field = shift;
  558 
  559     return $self->SUPER::LoadCustomFieldByIdentifier($field)
  560         if ref $field or $field =~ /^\d+$/;
  561 
  562     my $cf = RT::CustomField->new( $self->CurrentUser );
  563     $cf->SetContextObject( $self );
  564     $cf->LoadByNameAndCatalog( Name => $field, Catalog => $self->Catalog );
  565     $cf->LoadByNameAndCatalog( Name => $field, Catalog => 0 ) unless $cf->id;
  566     return $cf;
  567 }
  568 
  569 =head1 PRIVATE METHODS
  570 
  571 Documented for internal use only, do not call these from outside RT::Asset
  572 itself.
  573 
  574 =head2 _Set
  575 
  576 Checks if the current user can I<ModifyAsset> before calling C<SUPER::_Set>
  577 and records a transaction against this object if C<SUPER::_Set> was
  578 successful.
  579 
  580 =cut
  581 
  582 sub _Set {
  583     my $self = shift;
  584     my %args = (
  585         Field => undef,
  586         Value => undef,
  587         @_
  588     );
  589 
  590     return (0, $self->loc("Permission Denied"))
  591         unless $self->CurrentUserHasRight('ModifyAsset');
  592 
  593     my $old = $self->_Value( $args{'Field'} );
  594 
  595     my ($ok, $msg) = $self->SUPER::_Set(@_);
  596 
  597     # Only record the transaction if the _Set worked
  598     return ($ok, $msg) unless $ok;
  599 
  600     my $txn_type = $args{Field} eq "Status" ? "Status" : "Set";
  601 
  602     my ($txn_id, $txn_msg, $txn) = $self->_NewTransaction(
  603         Type     => $txn_type,
  604         Field    => $args{'Field'},
  605         NewValue => $args{'Value'},
  606         OldValue => $old,
  607     );
  608 
  609     # Ensure that we can read the transaction, even if the change just made
  610     # the asset unreadable to us.  This is only in effect for the lifetime of
  611     # $txn, i.e. as soon as this method returns.
  612     $txn->{ _object_is_readable } = 1;
  613 
  614     return ($txn_id, scalar $txn->BriefDescription);
  615 }
  616 
  617 =head2 _Value
  618 
  619 Checks L</CurrentUserCanSee> before calling C<SUPER::_Value>.
  620 
  621 =cut
  622 
  623 sub _Value {
  624     my $self = shift;
  625     return unless $self->CurrentUserCanSee;
  626     return $self->SUPER::_Value(@_);
  627 }
  628 
  629 sub Table { "RTxAssets" }
  630 
  631 sub _CoreAccessible {
  632     {
  633         id            => { read => 1, type => 'int(11)',        default => '' },
  634         Name          => { read => 1, type => 'varchar(255)',   default => '',  write => 1 },
  635         Status        => { read => 1, type => 'varchar(64)',    default => '',  write => 1 },
  636         Description   => { read => 1, type => 'varchar(255)',   default => '',  write => 1 },
  637         Catalog       => { read => 1, type => 'int(11)',        default => '0', write => 1 },
  638         Creator       => { read => 1, type => 'int(11)',        default => '0', auto => 1 },
  639         Created       => { read => 1, type => 'datetime',       default => '',  auto => 1 },
  640         LastUpdatedBy => { read => 1, type => 'int(11)',        default => '0', auto => 1 },
  641         LastUpdated   => { read => 1, type => 'datetime',       default => '',  auto => 1 },
  642     }
  643 }
  644 
  645 RT::Base->_ImportOverlays();
  646 
  647 1;