File Coverage

lib/Clearcase/UCM/Stream.pm

Criterion	Covered	Total	%
statement	6	40	15.0
branch	0	4	0.0
condition	0	4	0.0
subroutine	2	12	16.6
pod	9	10	90.0
total	17	70	24.2

=pod

=head1 NAME Stream.pm

Object oriented interface to UCM Streams

=head1 VERSION

=over

=item Author

Andrew DeFaria

=item Revision

$Revision: 1.8 $

=item Created

Fri May 14 18:16:16 PDT 2010

=item Modified

$Date: 2011/11/15 02:00:58 $

=back

=head1 SYNOPSIS

Provides access to information about Clearcase Streams.

  my $stream = new Clearcase::UCM::Stream ($name, $pvob);

=head1 DESCRIPTION

This module implements a UCM Stream object

=head1 ROUTINES

The following routines are exported:

=cut

package Clearcase::UCM::Stream;

use strict;
use warnings;

sub new ($$) {
  my ($class, $name, $pvob) = @_;

=pod

=head2 new

Construct a new Clearcase Stream object.

Parameters:

=for html

=over

=item name

Name of stream

=item pvob

Associated pvob

=back

=for html

Returns:

=for html

=over

=item Clearcase Stream object

=back

=for html

=cut

  $class = bless {
    name => $name,
    pvob => $pvob,
    },
    $class;    # bless

  return $class;
}    # new

sub name () {
  my ($self) = @_;

=pod

=head2 name

Returns the name of the stream

Parameters:

=for html

=over

=item none

=back

=for html

Returns:

=for html

=over

=item stream's name

=back

=for html

=cut

  return $self->{name};
}    # name

sub pvob () {
  my ($self) = @_;

=pod

=head2 pvob

Returns the pvob of the stream

Parameters:

=for html

=over

=item none

=back

=for html

Returns:

=for html

=over

=item stream's pvob

=back

=for html

=cut

  return $self->{pvob};
}    # pvob

sub create ($;$) {
  my ($self, $project, $opts) = @_;

=pod

=head2 create

Creates a new UCM Stream Object

Parameters:

=for html

=over

=item project

Project that this stream will be created in

=item opts

Options: Additional options to use (e.g. -baseline/-readonly)

=back

=for html

Returns:

=for html

=over

=item $status

Status from cleartool

=item @output

Ouput from cleartool

=back

=for html

=cut

  return (0, ()) if $self->exists;

  $opts ||= '';

  $self->{readonly} = $opts =~ /-readonly/;

  return $Clearcase::CC->execute ("mkstream $opts -in "
      . $project->name . '@'
      . $self->{pvob}->tag . ' '
      . $self->name . '@'
      . $self->{pvob}->tag);
}    # create

sub remove () {
  my ($self) = @_;

=pod

=head2 remove

Removes UCM Stream

Parameters:

=for html

=over

=back

=for html

Returns:

=for html

=over

=item $status

Status from cleartool

=item @output

Ouput from cleartool

=back

=for html

=cut

  return $Clearcase::CC->execute (
    'rmstream -f ' . $self->{name} . '@' . $self->{pvob}->name);
}    # rmStream

sub rebase($;$) {
  my ($self, $opts) = @_;

=pod

=head2 rebase

Rebases a UCM Stream

Parameters:

=for html

=over

=item baseline

Baseline to rebase to

=item opts

Any additional opts

=back

=for html

Returns:

=for html

=over

=item $status

Status from cleartool

=item @output

Ouput from cleartool

=back

=for html

=cut

  $opts ||= '';

  $opts .= ' -stream ' . $self->name . '@' . $self->{pvob}->name;

  return $Clearcase::CC->execute ("rebase $opts");
}    # rebase

sub recommend($) {
  my ($self, $baseline) = @_;

=pod

=head2 recommend

Recommends a baseline in a UCM Stream

Parameters:

=for html

=over

=item baseline

Baseline to recommend

=back

=for html

Returns:

=for html

=over

=item $status

Status from cleartool

=item @output

Ouput from cleartool

=back

=for html

=cut

  return $Clearcase::CC->execute ("chstream -recommended $baseline "
      . $self->name . '@'
      . $self->{pvob}->tag);
}    # recommend

sub nrecommended() {
  my ($self) = @_;

=pod

=head2 nrecommend

Changes stream to not have a recommended baseline

Parameters:

=for html

=over

=item none

=back

=for html

Returns:

=for html

=over

=item $status

Status from cleartool

=item @output

Ouput from cleartool

=back

=for html

=cut

  return $Clearcase::CC->execute (
    'chstream -nrecommended ' . $self->name . '@' . $self->{pvob}->tag);
}    # nrecommended

sub baselines () {
  my ($self) = @_;

=pod

=head2 baselines

Returns baseline objects associated with the stream

Parameters:

=for html

=over

=item none

=back

=for html

Returns:

=for html

=over

=item @baselines

An array of baseline objects for this stream

=back

=for html

=cut

  my $cmd = "lsbl -short -stream $self->{name}\@$self->{pvob}";

  $Clearcase::CC->execute ($cmd);

  return if $Clearcase::CC->status;

  my @baselines;

  for ($Clearcase::CC->output) {
    my $baseline = Clearcase::UCM::Baseline->new ($_, $self->{pvob});

    push @baselines, $baseline;
  }    # for

  return @baselines;
}    # baselines

sub exists() {
  my ($self) = @_;

=pod

=head3 exists

Return true if the stream exists - false otherwise

Paramters:

=for html

=over

=item none

=back

=for html

Returns:

=for html

=over

=item boolean

=back

=for html

=cut

  my ($status, @output) = $Clearcase::CC->execute (
    'lsstream ' . $self->{name} . '@' . $self->{pvob}->name);

  return !$status;
}    # exists

1;

=head1 DEPENDENCIES

=head2 Modules

=over

=item L

=item L

=item L

=back

=head1 INCOMPATABILITIES

None

=head1 BUGS AND LIMITATIONS

There are no known bugs in this module.

Please report problems to Andrew DeFaria .

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2020 by [e-mail]

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.38.0 or,
at your option, any later version of Perl 5 you may have available.

=cut