VCS::CMSynergy::Object - convenience wrapper to treat objectnames as an object


VCS-CMSynergy documentation Contained in the VCS-CMSynergy distribution.

Index


Code Index:

NAME

Top

VCS::CMSynergy::Object - convenience wrapper to treat objectnames as an object

SYNOPSIS

Top

  use VCS::CMSynergy;
  $ccm = VCS::CMSynergy->new(%attr);
  ...
  $obj = $ccm->object($name, $version, $cvtype, $instance);
  $obj = $ccm->object($objectname);
  print ref $obj;			# "VCS::CMSynergy::Object"

  # objectname and its constituents
  print "...and the object is $obj";
  print "name       = ", $obj->name;
  print "version    = ", $obj->version;
  print "cvtype     = ", $obj->cvtype;
  print "instance   = ", $obj->instance;
  print "objectname = ", $obj->objectname;

  # attribute methods, optionally caching with 
  #   use VCS::CMSynergy ':cached_attributes'
  print $obj->get_attribute('comment');
  $obj->set_attribute(comment => "blurfl");
  $obj->create_attribute("foo", string => "some text");
  $obj->delete_attribute("foo");
  $hashref = $obj->list_attributes;	# always caches result

  # property methods
  print $obj->property("bar");
  print $obj->displayname;		# always caches result

  ## tiehash interface
  use VCS::CMSynergy ':tied_objects';
  $ccm = VCS::CMSynergy->new(%attr);
  ...
  print $obj->{comment};	
  $obj->{comment} = "blurfl";	
  # same as:
  #   print $ccm->get_attribute(comment => $obj);
  #   $ccm->set_attribute(comment => $obj, "blurfl");




This synopsis only lists the major methods.

DESCRIPTION

Top

A VCS::CMSynergy::Object is mostly a glorified wrapper for a CM Synergy's objectname (sometimes called object reference form in CM Synergy documentation). Because of its overloaded string conversion method (see below), it can be used with VCS::CMSynergy methods wherever an objectname would be appropriate, esp. where the documentation specifies a file_spec.

When :cached_attributes in VCS::CMSynergy::Object is in effect, a VCS::CMSynergy::Object keeps a "demand loaded" cache of attribute names and values.

There is also a TIEHASH INTERFACE for manipulating an object's attributes using the hash notation.

BASIC METHODS

Top

new

  # let $ccm be a VCS::CMSynergy
  $obj = VCS::CMSynergy::Object->new(
    $ccm, $name, $version, $cvtype, $instance);

  # more conveniently
  $obj = $ccm->object($name, $version, $cvtype, $instance);
  $obj2 = $ccm->object("name-version:cvtype:instance");

Create a VCS::CMSynergy::Object from a CM Synergy session and either an objectname (sometimes called object reference form in CM Synergy documentation) in "name-version:cvtype:instance" format or the four parts specified separately.

Usually you would not call this method directly, but rather via the wrapper object in VCS::CMSynergy.

Note that no check is made whether the corresponding object really exists in the CM synergy database, use exists for that.

If you are useing :cached_attributes in VCS::CMSynergy, invoking new several times with the same objectname always returns the same VCS::CMSynergy::Object. This also holds for any method that returns VCS::CMSynergy::Objects (by calling new implicitly), e.g. object in VCS::CMSynergy or query_object in VCS::CMSynergy.

objectname

  print $obj->objectname;

Returns the object's complete name in object reference form, i.e. "name-version:cvtype:instance" where "-" is meant as a placeholder for the actual delimiter of the CM synergy database.

name, version, cvtype, instance

  print $obj->name;
  print $obj->version;
  print $obj->cvtype;
  print $obj->instance;

Returns the object's name, version, type, or instance, resp.

string conversion

VCS::CMSynergy::Object overloads string conversion with objectname, i.e. the following expressions evaluate to the same string:

  "$obj"  
  $obj->objectname

This makes it possible to use a VCS::CMSynergy::Object throughout VCS::CMSynergy wherever an objectname would have been appropriate.

is_project, is_dir

  if ($obj->is_project) { ... }

These are convenience functions that test whether the object's type is "project" or "dir", resp.

ccm

  $obj->ccm->query_hashref(...);

ccm returns the session (a VCS::CMSynergy) that is associated with the object.

cat_object

  $contents = $obj->cat_object();
  $obj->cat_object($destination);

A convenience wrapper for cat_object in VCS::CMSynergy.

mydata

Sometimes it is handy to be able to store some arbitrary data into a VCS::CMSynergy::Object. This method returns a reference to a hash associated with the object. It is totally opaque w.r.t. Synergy operations.

ATTRIBUTE METHODS

Top

get_attribute, set_attribute

  $value = $obj->get_attribute($attribute_name);
  $obj->set_attribute($attribute_name, $value);

These are convenience wrappers for get_attribute in VCS::CMSynergy and set_attribute in VCS::CMSynergy, resp., i.e.

  print $obj->get_attribute("comment");

is syntactic sugar for

  print $ccm->get_attribute("comment", $obj);

If you are useing :cached_attributes in VCS::CMSynergy, these methods maintain a cache of attribute names and values in the object. Note that this cache is only consulted if you use VCS::CMSynergy::Object methods (including the TIEHASH INTERFACE) and will get inconsistent if you mix VCS::CMSynergy::Object and VCS::CMSynergy calls on the same object.

create_attribute, delete_attribute

  $obj->create_attribute($attribute_name, $attribute_type, $value);
  $obj->delete_attribute($attribute_name);

Convenience wrappers for create_attribute in VCS::CMSynergy and delete_attribute in VCS::CMSynergy, resp. Also update the cache when :cached_attributes in VCS::CMSynergy is in effect.

copy_attribute

  $obj->copy_attribute($attribute_name, @to_file_specs);

Convenience wrapper for copy_attribute in VCS::CMSynergy. Also invalidate the cache entries for $attribute_name for all VCS::CMSynergy::Objects in @to_file_specs when :cached_attributes in VCS::CMSynergy is in effect.

Note: The optional $flags parameter of copy_attribute in VCS::CMSynergy is not supported, because it would mean traversing the target projects to update or invalidate attribute caches.

list_attributes

  $hashref = $obj->list_attributes;

Convenience wrapper for list_attributes in VCS::CMSynergy.

Note that the returned hash is always cached in the object (and updated for successful create_attribute and delete_attribute calls).

exists

  print "$obj doesn't exist" unless $obj->exists;

Tests whether the VCS::CMSynergy::Object corresponds to an object in the CM Synergy database (without causing an exception if it doesn't).

PROPERTY METHODS

Top

property

  $value = $obj->property($keyword);
  $hash = $obj->property(\@keywords);

Convenience wrapper for property in VCS::CMSynergy, equivalent to

  $value = $ccm->property($keyword, $obj);
  $hash = $ccm->property(\@keywords, $obj);

displayname, cvid

  print $obj->displayname;
  print $obj->cvid;

Short hand for $obj->property("displayname") or $obj->property("cvid"), resp. However, these two methods caches their return value in the VCS::CMSynergy::Object (because it is immutable).

is_RELATION_of, has_RELATION

Top

  $tasks = $obj->has_associated_cv;

These are convenience methods to quickly enumerate all objects that are somehow related to the invoking object:

  $obj->is_RELATION_of
  $obj->has_RELATION

are exactly the same as

  $obj->ccm->query_object("is_RELATION_of('$obj')")
  $obj->ccm->query_object("has_RELATION('$obj')")

If you supply extra arguments then these are passed down to query_object in VCS::CMSynergy as additional keywords.

See the CM Synergy documentation for the built-in relations. Note that it's not considered an error to use a non-existing relation, the methods will simply return (a reference to) an empty list. This is consistent with the behaviour of ccm query in this case.

TIEHASH INTERFACE

Top

  use VCS::CMSynergy ':tied_objects';
  ...
  print $obj->{comment};	
  $obj->{comment} = "blurfl";	

When useing :tied_objects in VCS::CMSynergy, you can use a VCS::CMSynergy::Object in the same way you would use a hash reference. The available keys are the underlying CM Synergy object's attributes.

Note that contrary to the behaviour of real hashes, keys don't spring into existence "on demand". Getting or setting the value of an attribute that does not exist for the underlying CM Synergy object will return undef or throw an excpetion (depending on your sessions's setting of RaiseError in VCS::CMSynergy). However, testing for the existence of an attribute with exists works as expected.

NOTE: When using :tied_objects in VCS::CMSynergy, it is strongly recommended to have Scalar::Util|"the Scalar::Util module" installed. See Why is Scalar::Util recommended? for an explanation.

FETCH, STORE

  $value = $obj->{attribute_name};
  $obj->{attribute_name} = $value;

These are wrappers for get_attribute and set_attribute, resp. The operate on the same cache as these when using :cached_attributes in VCS::CMSynergy

EXISTS

Checks the return value from list_attributes for the existence of the key (attribute) given.

FIRSTKEY, NEXTKEY

  foreach (@{ $obj->keys })  { ... }
  foreach (@{ $obj->values })  { ... }
  while (my ($attr, $val) = each %$obj)  { ... }

These methods use list_attributes to obtain a list of attributes and then iterate over this list. Hence keys, values, and each all work as expected.

Warning: Enumerating the keys (i.e. attribute names) of a tied VCS::CMSynergy::Object is cheap (at most one call to ccm attribute -la), but enumerating the values may result in lots of calls to ccm attribute -show. Tools like Data::Dumper or similar will implicitly enumerate all keys and values when invoked on a tied object. This is especially annoying when using the graphical Perl debugger Devel::ptkdb and mousing over a variable holding a tied object, because the debugger uses Data::Dumper to construct a printable representation of the object.

SEE ALSO

Top

VCS::CMSynergy


VCS-CMSynergy documentation Contained in the VCS-CMSynergy distribution.

package VCS::CMSynergy::Object;

# Copyright (c) 2001-2010 argumentum GmbH, 
# See COPYRIGHT section in VCS/CMSynergy.pod for usage and distribution rights.

our $VERSION = do { (my $v = q$Revision: 381 $) =~ s/^.*:\s*//; $v };

use strict;

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_ro_accessors(qw/objectname ccm name version cvtype instance/);

use Carp;
use VCS::CMSynergy::Client qw(_usage);

# NOTE: We can't just alias string conversion to objectname()
# as it is called (as overloaded operator) with three arguments
# which Class::Accessor's ro accessors dont't like.
use overload 
    '""'	=> sub { $_[0]->objectname },
    cmp		=> sub { $_[0]->objectname cmp $_[1]->objectname },
    fallback	=> 1;

my $have_weaken = eval "use Scalar::Util qw(weaken); 1";


my %cvtype2subclass = 
( 
    project	=> "Project",
);


# VCS::CMSynergy::Object->new(ccm, name, version, cvtype, instance)
# factory method
sub new
{
    unless (@_ == 6)
    {
	carp(__PACKAGE__ . " new: illegal number of arguments");
	return;
    }
    my $class = shift;
    my $ccm = shift;

    my $objectname = $_[0] . $ccm->delimiter . "$_[1]:$_[2]:$_[3]";
    return $ccm->{objects}->{$objectname} 
	if VCS::CMSynergy::use_cached_attributes() && $ccm->{objects}->{$objectname};

    my %fields;
    @fields{qw(name version cvtype instance)} = @_;
    $fields{objectname} = $objectname;
    $fields{ccm} = $ccm;
    Scalar::Util::weaken($fields{ccm}) if $have_weaken;
    $fields{acache} = {} if VCS::CMSynergy::use_cached_attributes();

    if (my $subclass = $cvtype2subclass{$fields{cvtype}})
    {
	require "VCS/CMSynergy/$subclass.pm";
	$class = "VCS::CMSynergy::$subclass";
    }

    my $self;
    if (VCS::CMSynergy::use_tied_objects())
    {
	$self = bless {}, $class;
	tie %$self, 'VCS::CMSynergy::ObjectTieHash', \%fields;
    }
    else
    {
	$self = bless \%fields, $class;
    }
    $ccm->{objects}->{$objectname} = $self if VCS::CMSynergy::use_cached_attributes();
    return $self;
}

# convenience methods for frequently used tests
sub is_dir	{ return shift->cvtype eq "dir"; }
sub is_project	{ return shift->cvtype eq "project"; }


# NOTE: All access to a VCS::CMSynergy::Objects data _must_ either use
# methods, e.g. "$self->foo", or use _private(), e.g. "$self->_private->{foo}".
# _Don't_ access its member directly, e.g. "$self->{foo}", because this
# doesn't work when :tied_objects are enabled.
# The only exception to this rule are the primary getter methods (objectname,
# version etc) which use direct access for speed. Hence they need to be
# redefined in ObjectTieHash.pm.

# access to private parts
sub _private 	{ return shift; }

sub mydata
{
    my ($self) = @_;
    return $self->_private->{mydata} ||= {};
}


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

    return $self->ccm->list_attributes($self);
}

sub get_attribute
{
    my ($self, $attr_name) = @_;

    if (VCS::CMSynergy::use_cached_attributes())
    {
	my $acache = $self->_private->{acache};
	return $acache->{$attr_name} if exists $acache->{$attr_name};
    }

    my $value = $self->ccm->get_attribute($attr_name, $self);

    $self->_update_acache($attr_name => $value);
    return $value;
}

sub set_attribute
{
    my ($self, $attr_name, $value) = @_;

    my $rc = $self->ccm->set_attribute($attr_name, $self, $value);

    if (defined $rc) { $self->_update_acache($attr_name => $value); }
    else             { $self->_forget_acache($attr_name); }

    return $rc;
}

sub create_attribute
{
    my $self = shift;
    _usage(@_, 3, 3, '$name, $type, $value');

    my ($attr_name, $type, $value) = @_;
    my $rc = $self->ccm->create_attribute($attr_name, $type, $value, $self);

    # update attribute cache if necessary
    $self->_update_acache($attr_name => $value) if $rc;

    return $rc;
}

sub delete_attribute
{
    my $self = shift;
    _usage(@_, 1, 1, '$name');

    my ($attr_name) = @_;
    my $rc = $self->ccm->delete_attribute($attr_name, $self);

    # update attribute cache if necessary
    # NOTE: the attribute may have reverted from local back to inherited
    $self->_forget_acache($attr_name) if $rc; 	

    return $rc;
}

sub copy_attribute
{
    my $self = shift;
    _usage(@_, 2, undef, '{ $name | \\@names }, $to_file_spec...');

    my ($names, @to_file_specs) = @_;

    # NOTE: no $flags allowed, because honouring them would need
    # a project traversal to update or invalidate attribute caches

    $names = [ $names ] unless UNIVERSAL::isa($names, 'ARRAY');

    my $rc = $self->ccm->copy_attribute($names, [], $self, @to_file_specs);

    if (VCS::CMSynergy::use_cached_attributes())
    {
	my @objects = grep { UNIVERSAL::isa($_, 'VCS::CMSynergy') } @to_file_specs;
	my $acache = $self->_private->{acache};

	foreach my $attr_name (@$names)
	{
	    if ($rc && exists $acache->{$attr_name})
	    {
		# if we already know the value of the copied attribute(s)
		# and the copy was successful, update the targets' caches
		my $value = $acache->{$attr_name};
		$_->_update_acache($attr_name => $value) foreach @objects;
	    }
	    else
	    {
		# in all other cases, invalidate the targets' caches
		# (esp. in case of failure, since we can't know 
		# which got actually updated)
		$_->_forget_acache($attr_name) foreach @objects;
	    }
	}
    }

    return $rc;
}

# $obj->_update_acache($name => $value) or
# $obj->_update_acache(\%attributes)
sub _update_acache
{
    return unless VCS::CMSynergy::use_cached_attributes();

    my $self = shift;
    if (@_ == 2)
    {
	$self->_private->{acache}->{$_[0]} = $_[1];
    }
    else
    {
	my $attrs = shift;
	@{$self->_private->{acache}}{keys %$attrs} = values %$attrs;
    }
}

# $obj->_forget_acache(@names)
sub _forget_acache
{
    return unless VCS::CMSynergy::use_cached_attributes();

    my $self = shift;
    delete $self->_private->{acache}->{$_} foreach @_;
}


# test whether object exists (without causing an exception)
sub exists
{
    my $self = shift;
    my ($rc) = $self->ccm->_ccm(qw/attribute -show version/, $self);
    return $rc == 0;
}

sub property
{
    my ($self, $keyword_s) = @_;

    my $props = $self->ccm->property($keyword_s, $self);
    $self->_update_acache(UNIVERSAL::isa($keyword_s, 'ARRAY') ? $props : { $keyword_s => $props });
    return $props;
}

sub displayname
{
    my ($self) = @_;
    # cache this property (because it's immutable)
    return $self->_private->{displayname} ||= $self->property('displayname');
}

sub cvid
{
    my ($self) = @_;
    # cache this property (because it's immutable)
    return $self->_private->{cvid} ||= $self->property('cvid');
}

sub cat_object
{
    my $self = shift;
    # NOTE: careful here to correctly handle the case when 
    # no destination was given
    return $self->ccm->cat_object($self, @_);
}

# $obj->is_foo_of: short for $ccm->query_object({is_foo_of => [ $obj ]})
# same for has_foo
sub AUTOLOAD
{
    my $this = shift;

    our $AUTOLOAD;

    # NOTE: the fully qualified name of the method has been placed in $AUTOLOAD
    my ($class, $method) = $AUTOLOAD =~ /^(.*)::([^:]*)$/;
    return if $method eq 'DESTROY'; 

    # we don't allow autoload of class methods
    croak("Can't locate class method \"$method\" via class \"$class\"")
	unless ref $this;

    if ($method =~ /^(is_.*_of|has_.*)$/)
    {
	return $this->ccm->query_object("$method('$this')", @_);
    }
    croak("Can't locate object method \"$method\" via class \"$class\"");
}


1;

__END__