package DTS::Assignment;

=head1 NAME

DTS::Assignment - a Perl base class to represent a DTS Dynamic Properties task Assignment object

=head1 SYNOPSIS

 package DTS::Assignment::SomethingWeird;
 use base (DTS::Assignment);

 #and goes on defining the child class

=head1 DESCRIPTION

C<DTS::Assignment> is a base class that should be inherited by a specialized class that defines one type of
Assignment object that is part of a DTS Dynamic Property task.

This class defines some common attributes that a subclass of C<DTS::Assignment>. Some methods must be override too,
and are explained in the next sections.

=head2 EXPORT

None by default.

=cut

use 5.008008;
use strict;
use warnings;
use base qw(DTS);
use Carp qw(confess);
use DTS::AssignmentTypes;
use DTS::Assignment::DestinationFactory;

our $VERSION = '0.03';

=head2 METHODS

=head3 new

Instantiates a new C<DTS::Assigment> object. Expects as parameter a C<DynamicPropertiesTaskAssignment> object. 
Unless you want to extend the C<DTS::Assignment> class, you will want to fetch C<DTS::Assignment> objects using 
the C<get_properties> method from L<DTS::Task::DynamicProperty|DTS::Task::DynamicProperty> class.

=cut

sub new {

    my $class = shift;
    my $self = { _sibling => shift };

    bless $self, $class;

    my $sibling = $self->get_sibling();

    $self->{destination} = DTS::Assignment::DestinationFactory->create(
        $sibling->{DestinationPropertyID} );

    # subscribing to the event of changing the destination string in the
    # DTS::Assignment::Destination object
    $self->{destination}
      ->add_subscriber( 'changed', sub { $self->_set_destination() } );

    $self->{typename} =
      DTS::AssignmentTypes->get_class_name( $sibling->SourceType() );

    $self->{type} = $sibling->SourceType();

    return $self;

}

=head3 get_type

Returns the type as a numeric code for a instantied object of a subclass of C<DTS::Assignment>.

=cut

sub get_type {

    my $self = shift;
    return $self->{type};

}

=head3 get_type_name

Returns a type as a string converted from the original numeric code using L<DTS::AssignmentTypes|DTS::AssignmentTypes>
abstract class to make the convertion.

=cut

sub get_type_name {

    my $self = shift;
    return $self->{typename};

}

=head3 get_source

This method should be override by any subclass of C<DTS::Assignment>. If invoked but not overrided, it will abort
program execution with an error message.

=cut

sub get_source {

    confess
"This method should be override by an specialized subclass of DTS::Assignment\n";

}

=head3 get_destination

Returns a C<DTS::Assignment::Destination> object. See L<DTS::Assignment::Destination> for more details about how
to use Destination objects.

A C<DTS::Assignment::Destination> object is not part of the official MS SQL Server DTS API, but is easier to use and
do not use L<Win32::OLE|Win32::OLE> directly (so there are no great performance penalties).

=cut

sub get_destination {

    my $self = shift;

    return $self->{destination};

}

=head3 set_destination

Sets the Destination string in the assignment (in other words, it writes directly in the DTS package). To be able to
invoke this method, the C<DTS::Assignment> should not have invoke the C<kill_sibling> method before, since writing
the DTS package requires having the C<_sibling> attribute defined.

The method will check such condition and will abort program execution in such cases.

Once the string is modified successfully in the package, the C<DTS::Assignment::Destination> will be modified as well
(a new instance will be created).

=cut

sub set_destination {

    my $self       = shift;
    my $new_string = shift;

    # modifying both attributes. set_string does some validation,
    # so it's being called first
    $self->{destination}->set_string($new_string);

    confess "The new string cannot be undefined"
      unless ( defined($new_string) );

    $self->get_sibling()->DestinationPropertyID = $new_string;

}

# destination object is already updated, fetching the
# string value from the object
sub _set_destination {

    my $self = shift;

    $self->get_sibling()->DestinationPropertyID() =
      $self->{destination}->get_raw_string();

}

=head3 get_properties

Returns all properties from an assignment object as a hash reference, having the following keys:

=over

=item *
type

=item *
source

=item *
destination

=back

Since the method C<get_source> must be overrided by subclasses of C<DTS::Assignment>, C<get_properties> will fail unless invoked 
thru one of those subclasses.

=cut

sub get_properties {

    my $self = shift;

    return {
        type        => $self->get_type(),
        source      => scalar( $self->get_source() ),
        destination => scalar( $self->get_destination() )
      }

}

=head3 to_string 

Returns a string with the type, source and destination of an assignment. Useful for debugging or reporting.

=cut

sub to_string {

    my $self = shift;

    return $self->get_type_name
      . " assignment\n"
      . 'Source: '
      . $self->get_source . "\n"
      . 'Destination: '
      . $self->get_destination . "\n";

}

1;

__END__

=head1 SEE ALSO

=over

=item *
L<Win32::OLE> at C<perldoc>.

=item *
L<DTS::AssignmentFactory> at C<perldoc>.

=item *
L<DTS::Assignment::Destination> and all subclasses of it at C<perldoc>.

=item *
MSDN on Microsoft website and MS SQL Server 2000 Books Online are a reference about using DTS'
object hierarchy, but one will need to convert examples written in VBScript to Perl code.

=back

=head1 AUTHOR

Alceu Rodrigues de Freitas Junior, E<lt>arfreitas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by Alceu Rodrigues de Freitas Junior

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

=cut