"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;