File Coverage

lib/Clearcase/UCM/Folder.pm
Criterion Covered Total %
statement 6 38 15.7
branch 0 12 0.0
condition 0 4 0.0
subroutine 2 11 18.1
pod 8 9 88.8
total 16 74 21.6


line stmt bran cond sub pod time code
1              
2             =pod
3              
4             =head1 NAME Folder.pm
5              
6             Object oriented interface to UCM Folders
7              
8             =head1 VERSION
9              
10             =over
11              
12             =item Author
13              
14             Andrew DeFaria
15              
16             =item Revision
17              
18             $Revision: 1.8 $
19              
20             =item Created
21              
22             Fri May 14 18:16:16 PDT 2010
23              
24             =item Modified
25              
26             $Date: 2011/11/15 02:00:58 $
27              
28             =back
29              
30             =head1 SYNOPSIS
31              
32             Provides access to information about Clearcase Folders.
33              
34             my $folder = new Clearcase::UCM::Folder ($name, $pvob);
35              
36             =head1 DESCRIPTION
37              
38             This module implements a UCM Folder object
39              
40             =head1 ROUTINES
41              
42             The following routines are exported:
43              
44             =cut
45              
46             package Clearcase::UCM::Folder;
47              
48 1     1   913 use strict;
  1         2  
  1         30  
49 1     1   3 use warnings;
  1         1  
  1         531  
50              
51             sub new ($$;$$) {
52 0     0 1   my ($class, $name, $pvob, $parent, $comment) = @_;
53              
54             =pod
55              
56             =head2 new
57              
58             Construct a new Clearcase Folder object.
59              
60             Parameters:
61              
62             =for html
63              
64             =over
65              
66             =item folder
67              
68             Name of folder
69              
70             =back
71              
72             =for html
73              
74             Returns:
75              
76             =for html
77              
78             =over
79              
80             =item Clearcase Folder object
81              
82             =back
83              
84             =for html
85              
86             =cut
87              
88 0   0       $class = bless {
89             name => $name,
90             pvob => $pvob,
91             parent => $parent || 'RootFolder',
92             },
93             $class; # bless
94              
95 0           $comment = Clearcase::setComment ($comment);
96              
97             my ($status, @output) =
98             $Clearcase::CC->execute ("mkfolder $comment -in "
99 0           . $class->{parent} . ' '
100             . $name . '@'
101             . $pvob->tag);
102              
103 0 0         return if $status;
104              
105 0           ($status, @output) = $class->updateFolderInfo;
106              
107 0 0         return $status ? undef : $class;
108             } # new
109              
110             sub name () {
111 0     0 1   my ($self) = @_;
112              
113             =pod
114              
115             =head2 name
116              
117             Returns the name of the folder
118              
119             Parameters:
120              
121             =for html
122              
123             =over
124              
125             =item none
126              
127             =back
128              
129             =for html
130              
131             Returns:
132              
133             =for html
134              
135             =over
136              
137             =item folder's name
138              
139             =back
140              
141             =for html
142              
143             =cut
144              
145 0           return $self->{name};
146             } # name
147              
148             sub owner () {
149 0     0 1   my ($self) = @_;
150              
151             =pod
152              
153             =head2 owner
154              
155             Returns the owner of the folder
156              
157             Parameters:
158              
159             =for html
160              
161             =over
162              
163             =item none
164              
165             =back
166              
167             =for html
168              
169             Returns:
170              
171             =for html
172              
173             =over
174              
175             =item folder's owner
176              
177             =back
178              
179             =for html
180              
181             =cut
182              
183 0           return $self->{owner};
184             } # owner
185              
186             sub group () {
187 0     0 1   my ($self) = @_;
188              
189             =pod
190              
191             =head2 group
192              
193             Returns the group of the folder
194              
195             Parameters:
196              
197             =for html
198              
199             =over
200              
201             =item none
202              
203             =back
204              
205             =for html
206              
207             Returns:
208              
209             =for html
210              
211             =over
212              
213             =item folder's group
214              
215             =back
216              
217             =for html
218              
219             =cut
220              
221 0           return $self->{group};
222             } # group
223              
224             sub pvob () {
225 0     0 1   my ($self) = @_;
226              
227             =pod
228              
229             =head2 pvob
230              
231             Returns the pvob of the folder
232              
233             Parameters:
234              
235             =for html
236              
237             =over
238              
239             =item none
240              
241             =back
242              
243             =for html
244              
245             Returns:
246              
247             =for html
248              
249             =over
250              
251             =item folder's pvob
252              
253             =back
254              
255             =for html
256              
257             =cut
258              
259 0           return $self->{pvob};
260             } # pvob
261              
262             sub title () {
263 0     0 1   my ($self) = @_;
264              
265             =pod
266              
267             =head2 title
268              
269             Returns the title of the folder
270              
271             Parameters:
272              
273             =for html
274              
275             =over
276              
277             =item none
278              
279             =back
280              
281             =for html
282              
283             Returns:
284              
285             =for html
286              
287             =over
288              
289             =item folder's title
290              
291             =back
292              
293             =for html
294              
295             =cut
296              
297 0           return $self->{title};
298             } # title
299              
300             sub create ($;$) {
301 0     0 1   my ($self, $name, $parentFolder) = @_;
302              
303             =pod
304              
305             =head2 create
306              
307             Creates a new UCM Folder Object
308              
309             Parameters:
310              
311             =for html
312              
313             =over
314              
315             =item name
316              
317             UCM Folder name
318              
319             =item parentFolder
320              
321             Name of parentFolder (Default: RootFolder)
322              
323             =back
324              
325             =for html
326              
327             Returns:
328              
329             =for html
330              
331             =over
332              
333             =item $status
334              
335             Status from cleartool
336              
337             =item @output
338              
339             Ouput from cleartool
340              
341             =back
342              
343             =for html
344              
345             =cut
346              
347             # Fill in object members
348 0           $self->{parentFolder} = $parentFolder;
349              
350 0   0       $parentFolder ||= 'RootFolder';
351              
352             # Need to create the folder
353             return $Clearcase::CC->execute ("mkfolder $self->{comment} -in "
354             . $parentFolder . '@'
355             . $self->{pvob} . ' '
356 0           . $self->{name});
357             } # create
358              
359             sub remove () {
360 0     0 1   my ($self) = @_;
361              
362             =pod
363              
364             =head2 remove
365              
366             Removes UCM Folder
367              
368             Parameters:
369              
370             =for html
371              
372             =over
373              
374             =item name
375              
376             UCM Folder name
377              
378             =back
379              
380             =for html
381              
382             Returns:
383              
384             =for html
385              
386             =over
387              
388             =item $status
389              
390             Status from cleartool
391              
392             =item @output
393              
394             Output from cleartool
395              
396             =back
397              
398             =for html
399              
400             =cut
401              
402             return $Clearcase::CC->execute (
403 0           'rmfolder -f ' . $self->{name} . "\@" . $self->{pvob}->tag);
404             } # rmfolder
405              
406             sub updateFolderInfo () {
407 0     0 0   my ($self) = @_;
408              
409             my ($status, @output) = $Clearcase::CC->execute (
410 0           "lsfolder -long $self->{name}" . '@' . $self->{pvob}->tag);
411              
412 0 0         return if $status;
413              
414 0           for (@output) {
415 0 0         if (/owner: (.*)/) {
    0          
    0          
416 0           $self->{owner} = $1;
417             } elsif (/group: (.*)/) {
418 0           $self->{group} = $1;
419             } elsif (/title: (.*)/) {
420 0           $self->{title} = $1;
421              
422             # TODO: Get containing folders and containing projects
423             } # if
424             } # for
425              
426 0           return $self;
427             } # updateFolderInfo
428              
429             1;
430              
431             =head1 DEPENDENCIES
432              
433             =head2 Modules
434              
435             =over
436              
437             =item L
438              
439             =item L
440              
441             =back
442              
443             =head1 INCOMPATABILITIES
444              
445             None
446              
447             =head1 BUGS AND LIMITATIONS
448              
449             There are no known bugs in this module.
450              
451             Please report problems to Andrew DeFaria .
452              
453             =head1 COPYRIGHT AND LICENSE
454              
455             Copyright (C) 2020 by Andrew@DeFaria.com
456              
457             This library is free software; you can redistribute it and/or modify
458             it under the same terms as Perl itself, either Perl version 5.38.0 or,
459             at your option, any later version of Perl 5 you may have available.
460              
461             =cut