Toby Inkster avatar Toby Inkster committed 032a52e

new module

Comments (0)

Files changed (25)

+#############################################################
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dcs:     <http://ontologi.es/doap-changeset#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix foaf:    <http://xmlns.com/foaf/0.1/> .
+@prefix my:      <http://purl.org/NET/cpan-uri/dist/Example-Example/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix toby:    <http://tobyinkster.co.uk/#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+#############################################################
+
+<>
+
+	dc:title         "Changes" ;
+	dc:description   "Revision history for Perl extension Example::Example."@en ;
+	dc:subject       my:project ;
+	dc:creator       toby:i .
+
+#############################################################
+
+my:v_0-01
+
+	a               :Version ;
+	dc:issued       "2000-01-01"^^xsd:date ;
+	:revision       "0.01"^^xsd:string ;
+	:file-release   <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/Example-Example-0.01.tar.gz> ;
+	rdfs:comment    "Original version"@en .
+
+#############################################################
+
+my:project
+
+	a               :Project ;
+	:name           "Example-Example" ;
+	:shortdesc      "Example Project"@en ;
+	:programming-language  "Perl" ;
+	:homepage       <http://search.cpan.org/dist/Example-Example/> ;
+	:download-page  <http://search.cpan.org/dist/Example-Example/> ;
+	:bug-database   <http://rt.cpan.org/Dist/Display.html?Queue=Example-Example> ;
+	:repository     [ a :SVNRepository ; :browse <http://goddamn.co.uk/viewvc/perlmods/Example-Example/> ] ;
+	:maintainer     toby:i ;
+	:developer      toby:i ;
+	:documenter     toby:i ;
+	:tester         toby:i ;
+	:created        "2000-01-01"^^xsd:date ;
+	:license        <http://dev.perl.org/licenses/> ;
+	:release        my:v_0-01 .
+
+#############################################################
+
+toby:i
+
+	a               foaf:Person ;
+	foaf:name       "Toby Inkster" ;
+	foaf:homepage   <http://tobyinkster.co.uk/> ;
+	foaf:page       <http://search.cpan.org/~tobyink/> ;
+	foaf:mbox       <mailto:tobyink@cpan.org> ;
+	<http://www.w3.org/2002/07/owl#sameAs> <http://purl.org/NET/cpan-uri/person/tobyink> .
+
+#############################################################
+Changes
+Changes.ttl
+Changes.xml
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+META.yml
+SIGNATURE
+
+t/00sig.t
+t/01basic.t
+^Makefile$
+^blib/
+^pm_to_blib
+^blibdirs
+\.svn
+^example.*\.pl$
+^[^/]+\.(tar\.gz|tar\.bz2|tgz|tbz2|tbz|zip|tar)$
+^MYMETA.yml
+use strict;
+use warnings;
+
+use inc::Module::Install;
+
+my $dist = 'Example-Example';
+my $fn   = "lib/$dist.pm"; $fn =~ s#-#/#g;
+
+name                $dist;
+perl_version_from   $fn;
+version_from        $fn;
+abstract_from       $fn;
+readme_from         $fn;
+author              'Toby Inkster <tobyink@cpan.org>';
+license             'perl';
+
+test_requires       'Test::More'         => '0.61';
+test_requires       'Module::Signature'  => '0.66';
+requires            'Carp'               => '1.00';
+requires            'DateTime'           => 0;
+requires            'RDF::Trine'         => '0.112';
+requires            'XML::LibXML'        => '1.60';
+requires            'URI'                => '1.30';
+
+# install_script 'fingerw';
+
+resources(
+	'homepage'   => "http://search.cpan.org/dist/$dist/",
+	'repository' => "http://goddamn.co.uk/viewvc/perlmods/$dist/",
+	'bugtracker' => "http://rt.cpan.org/Dist/Display.html?Queue=$dist",
+	);
+
+keywords("Perl");
+	
+write_doap_changes;
+write_doap_changes_xml;
+
+include 'Test::Signature';
+auto_install;
+WriteAll(
+	'meta' => 1,
+	'sign' => 1,
+	);
+[sql]
+host=192.168.100.108
+port=1433
+database=NCT_live
+username=perl
+password=perl
+
+[webservice]
+endpoint=http://acton-8.nct.org.uk:8022/CAREServices/NDataAccess.asmx
+database=NCT_live
+username=guest
+password=guest
+package CRM::CARE;
+
+use 5.008;
+use common::sense;
+use Moose;
+
+use CRM::CARE::Address;
+use CRM::CARE::Contact;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+has 'webservice_endpoint' => (is => 'rw', isa => 'Str', required => 1);
+has 'webservice_database' => (is => 'rw', isa => 'Str', required => 1);
+has 'webservice_username' => (is => 'rw', isa => 'Str', required => 1);
+has 'webservice_password' => (is => 'rw', isa => 'Str', required => 1);
+
+has 'sql_database' => (is => 'rw', isa => 'Str', required => 1);
+has 'sql_username' => (is => 'rw', isa => 'Str', required => 1);
+has 'sql_password' => (is => 'rw', isa => 'Str', required => 1);
+has 'sql_host' => (is => 'rw', isa => 'Str', required => 1);
+has 'sql_port' => (is => 'rw', isa => 'Int', default => 1433);
+
+with 'CRM::CARE::Trait::Configurable';
+with 'CRM::CARE::Trait::Queryable';
+with 'CRM::CARE::Trait::WebServices';
+
+sub configfile
+{
+	my ($class) = @_;
+	my $name = ref $class ? lc ref $class : lc $class;
+	$name =~ s/::/-/g;
+	$name .= '.ini';
+	
+	return (
+		$name,
+		sprintf("/etc/%s", $name),
+		sprintf("C:\\Windows\\%s", $name),
+		);
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+
+__END__
+
+=head1 NAME
+
+CRM;;CARE - Perl API for IRIS CARE database.
+
+=head1 DESCRIPTION
+
+CARE is a customer/client/contact relationship manager product for the
+not-for-profit sector. It was originally produced by Care Software Ltd,
+but acquired in turn by the Computer Software Group, and IRIS.
+
+The software is backed by an Oracle or Microsoft SQL Server relational
+database. IRIS make two clients available for it: a rich client that
+interacts directly via SQL, and the "smart client" which interacts with
+a slim web service layer on the server.
+
+The web services are written in .NET and exposed via a slightly unusual
+flavour of SOAP.
+
+This module allows you to access the web services, and provides some stub
+functions for connecting to the SQL database via DBI. (Only tested on
+Microsoft SQL Server.)
+
+There are also a bunch of wrapper modules to expose various key CARE
+concepts - contacts, addresses, organisations, categories, etc.
+
+The CRM::CARE module itself does the following Moose traits:
+
+=over
+
+=item * L<CRM::CARE::Trait::Configurable>
+
+=item * L<CRM::CARE::Trait::Queryable>
+
+=item * L<CRM::CARE::Trait::WebServices>
+
+=back
+
+CRM::CARE provides the following attributes:
+
+=over
+
+=item * C<webservice_endpoint>
+
+=item * C<webservice_database>
+
+=item * C<webservice_username>
+
+=item * C<webservice_password>
+
+=item * C<sql_host>
+
+=item * C<sql_port>
+
+=item * C<sql_database>
+
+=item * C<sql_username>
+
+=item * C<sql_password>
+
+=back
+
+It provides the following additional method:
+
+=over
+
+=item *C<configfile>
+
+Returns a list of config file names that would be used by the
+C<new_from_config> constructor.
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+This module is I<not> a product of IRIS, and is I<not> supported by them
+in any way.
+
+SQL functionality has not been tested on Oracle.
+
+Please report any bugs to L<http://rt.cpan.org/>.
+
+=head1 SEE ALSO
+
+L<http://www.iris.co.uk/>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Address.pm

+package CRM::CARE::Address;
+
+use 5.008;
+use common::sense;
+use Moose;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+has 'AddressNumber'  => (is => 'ro', isa => 'Int', required => 1);
+has 'ContactNumber'  => (is => 'rw', isa => 'Int', required => 1);
+
+has [qw{
+	HouseName
+	Address
+	Town
+	County
+	Postcode
+	CountryCode
+	CountryDesc
+	SortCode
+	PafStatus
+	Branch
+	}] => (is => 'rw', isa => 'Str');
+
+with 'CRM::CARE::Trait::WithDefaultConnection';
+with 'CRM::CARE::Trait::Amendable';
+with 'CRM::CARE::Trait::Validable';
+with 'CRM::CARE::Trait::Updater';
+
+sub _update_method
+{
+	return UpdateAddress => qw(
+		HouseName
+		Address
+		Town
+		County
+		Postcode
+		PafStatus
+		Branch
+		ValidFrom
+		ValidTo
+		),
+		[CountryCode => 'Country'];
+}
+
+__PACKAGE__->meta->make_immutable;
+1;

lib/CRM/CARE/Contact.pm

+package CRM::CARE::Contact;
+
+use 5.008;
+use common::sense;
+use Moose;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+use CRM::CARE::TypeLibrary ':all';
+
+has 'ContactNumber'  => (is => 'ro', isa => 'Int', required => 1);
+has 'AddressNumber'  => (is => 'rw', isa => 'Int');
+
+has [qw{
+	Title
+	Initials
+	Forenames
+	Surname
+	Honorifics
+	Salutation
+	LabelName
+	PreferredForename
+	Sex
+	Source
+	SourceDesc
+	Status
+	StatusDesc
+	StatusReason
+	Department
+	OwnershipGroup
+	PrincipalUser
+	PrincipalUserReason
+	VatCategory
+	VatNumber
+	}] => (is => 'rw', isa => 'Str');
+
+has [qw{
+	SourceDate
+	StatusDate
+	}] => (is => 'rw', isa => 'CareDate', coerce => 1);
+
+with 'CRM::CARE::Trait::WithDefaultConnection';
+with 'CRM::CARE::Trait::Loader';
+with 'CRM::CARE::Trait::Updater';
+with 'CRM::CARE::Trait::Amendable';
+
+sub _retrieve_method  { return FindContacts => qw(ContactNumber); }
+sub _update_method
+{
+	return UpdateContact => qw(
+		ContactNumber
+		Title
+		Initials
+		Forenames
+		Surname
+		Honorifics
+		Salutation
+		LabelName
+		PreferredForename
+		Sex
+		Source
+		Status
+		StatusReason
+		Department
+		OwnershipGroup
+		PrincipalUser
+		PrincipalUserReason
+		VatCategory
+		VatNumber
+		SourceDate
+		StatusDate
+		);
+}
+
+sub _SelectContactData
+{
+	my ($self, @x) = @_;
+	my ($care, $type, %args) = $self->process_method_arguments(@x);
+	$args{ContactNumber} = $self->ContactNumber;
+
+	if (my $bless = delete $args{bless})
+	{
+		return map
+			{ $bless->new(%$_) }
+			$care->SelectContactData({pSelectDataType => $type}, %args);
+	}
+	
+	return $care->SelectContactData({pSelectDataType => $type}, %args);
+}
+
+sub information
+{
+	my ($self) = @_;
+	my $i = $self->_SelectContactData('xcdtContactInformation');
+	foreach (keys %$i)
+	{
+		$self->$_($i->{$_})
+			if $self->can($_) && !defined $self->$_;
+	}
+	return $i;
+}
+
+sub addresses
+{
+	my ($self) = @_;
+	return $self->_SelectContactData('xcdtContactAddresses', bless=>'CRM::CARE::Address');
+}
+
+sub activities
+{
+	my ($self) = @_;
+	return $self->_SelectContactData('xcdtContactCategories');
+}
+
+sub suppressions
+{
+	my ($self) = @_;
+	return $self->_SelectContactData('xcdtContactSuppressions');
+}
+
+__PACKAGE__->meta->make_immutable;
+1;
+
+=head1 NAME
+
+CRM::CARE::Contact - a contact
+
+=head1 DESCRIPTION
+
+This class represents a contact: that is a record from the CARE
+C<"contacts"> table.
+
+=head2 Traits
+
+=over
+
+=item * C<CRM::CARE::Trait::WithDefaultConnection>
+
+=item * C<CRM::CARE::Trait::Loader>
+
+=item * C<CRM::CARE::Trait::Updater>
+
+=item * C<CRM::CARE::Trait::Amendable>
+
+=back
+
+=head2 Constructors
+
+=over
+
+=item * C<new>
+
+=item * C<retrieve>
+
+Takes a contact number. See L<CRM::CARE::Trait::Loader>.
+
+=back
+
+=head2 Attributes
+
+=over
+
+=item * C<ContactNumber>
+
+=item * C<AddressNumber>
+
+=item * C<Title>
+
+=item * C<Initials>
+
+=item * C<Forenames>
+
+=item * C<Surname>
+
+=item * C<Honorifics>
+
+=item * C<Salutation>
+
+=item * C<LabelName>
+
+=item * C<PreferredForename>
+
+=item * C<Sex>
+
+=item * C<Source>
+
+=item * C<SourceDate>
+
+=item * C<SourceDesc>
+
+=item * C<Status>
+
+=item * C<StatusDate>
+
+=item * C<StatusDesc>
+
+=item * C<StatusReason>
+
+=item * C<Department>
+
+=item * C<OwnershipGroup>
+
+=item * C<PrincipalUser>
+
+=item * C<PrincipalUserReason>
+
+=item * C<VatCategory>
+
+=item * C<VatNumber>
+
+=back
+
+B<Note on FoobarDesc attributes:> some attributes are logically tied together,
+such as C<Source> and C<SourceDesc>. The first provides an alphanumeric
+code; the second provides a description for that code. However, the descriptions
+aren't programmatically tied to the codes. So if you change the code, the
+description will remain unchanged (and thus wrong). When C<update> is
+called, it is the code that is saved back to the database, not the description.
+
+=head2 Methods
+
+=over
+
+=item * C<information>
+
+=item * C<addresses>
+
+=item * C<activities>
+
+=item * C<suppressions>
+
+=back
+
+=head1 SEE ALSO
+
+L<CRM::CARE>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/ContactCategory.pm

+package CRM::CARE::ContactCategory;
+
+use 5.008;
+use common::sense;
+use Moose;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+use CRM::CARE::TypeLibrary ':all';
+
+has 'ContactNumber'     => (is => 'ro', isa => 'Int', required => 1);
+has 'ActivityCode'      => (is => 'rw', isa => 'Str', required => 1);
+has 'ActivityValueCode' => (is => 'rw', isa => 'Str', required => 1);
+has 'Quantity'          => (is => 'rw', isa => 'Int');
+has 'ActivityDate'      => (is => 'rw', isa => 'CareDate', coerce => 1);
+
+has [qw{
+	ActivityDesc
+	ActivityValueDesc
+	SourceCode
+	SourceDesc
+	Notes
+	}] => (is => 'rw', isa => 'Str');
+
+with 'CRM::CARE::Trait::WithDefaultConnection';
+with 'CRM::CARE::Trait::Amendable';
+with 'CRM::CARE::Trait::Validable';
+
+__PACKAGE__->meta->make_immutable;
+1;

lib/CRM/CARE/ContactSuppression.pm

+package CRM::CARE::ContactSuppression;
+
+use 5.008;
+use common::sense;
+use Moose;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+has 'ContactNumber'     => (is => 'ro', isa => 'Int', required => 1);
+has 'SuppressionCode'   => (is => 'rw', isa => 'Str', required => 1);
+
+has [qw{
+	SuppressionDesc
+	SuppressionInformation
+	Notes
+	}] => (is => 'rw', isa => 'Str');
+
+with 'CRM::CARE::Trait::WithDefaultConnection';
+with 'CRM::CARE::Trait::Amendable';
+with 'CRM::CARE::Trait::Validable';
+
+__PACKAGE__->meta->make_immutable;
+1;

lib/CRM/CARE/Exception/WebServices.pm

+package CRM::CARE::Exception::WebServices;
+
+use 5.008;
+use common::sense;
+use Moose;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+use overload '""' => \&to_string;
+
+has 'ErrorNumber'  => (is => 'rw', isa => 'Int', required => 1);
+has 'ErrorMessage' => (is => 'rw', isa => 'Str', required => 1);
+has 'Method'       => (is => 'rw', isa => 'Str');
+has 'Module'       => (is => 'rw', isa => 'Str');
+has 'Source'       => (is => 'rw', isa => 'Str');
+
+with 'Throwable';
+with 'StackTrace::Auto';
+
+sub to_string
+{
+	my ($self) = @_;
+	return sprintf("Error %d: %s\n", $self->ErrorNumber, $self->ErrorMessage);
+}
+
+1;

lib/CRM/CARE/Trait/Amendable.pm

+package CRM::CARE::Trait::Amendable;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use namespace::clean -except => 'meta';
+
+use CRM::CARE::TypeLibrary ':all';
+
+our $VERSION = '0.001';
+
+has 'AmendedBy'  => (is => 'rw', isa => 'Str');
+has 'AmendedOn'  => (is => 'rw', isa => 'CareDate', coerce => 1);
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::Amendable - trait for handling provenance
+
+=head1 DESCRIPTION
+
+Provides C<AmendedBy> and C<AmendedOn> attributes. The latter returns
+a DateTime object.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/Configurable.pm

+package CRM::CARE::Trait::Configurable;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use Config::Tiny;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+requires 'new';
+requires 'configfile';
+
+sub new_from_config
+{
+	my ($class, %args) = @_;
+	my @configfile = $class->configfile;
+	
+	if (exists $args{configfile})
+	{
+		$args{configfile} = [$args{configfile}] unless ref $args{configfile} eq 'ARRAY';
+		@configfile = (@{ $args{configfile} }, @configfile);
+		delete $args{configfile};
+	}
+	
+	my $file;
+	FILE: foreach (@configfile)
+	{
+		if (-e)
+		{
+			$file = $_;
+			last FILE;
+		}
+	}
+	confess sprintf("None of the configfiles (%s) exist.", join('|', @configfile))
+		unless defined $file;
+
+	my %parameters = %args;
+	my $ct = Config::Tiny->read($file);
+	foreach my $section (keys %$ct)
+	{
+		foreach my $key (keys %{ $ct->{$section} })
+		{
+			my $p = $section eq '_' ? $key : sprintf('%s_%s', $section, $key);
+			$parameters{$p} = $ct->{$section}{$key};
+		}
+	}
+	
+	$class->new(%parameters);
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::Configurable - trait to load configuration from an INI file
+
+=head1 SYNOPSIS
+
+ my $obj = CRM::CARE->new_from_config(configfile => 'my.ini', %additional);
+
+=head1 DESCRIPTION
+
+Any class that uses this trait gets a C<new_from_config> constructor which
+loads a new object from a configfile. The constructor can take additional
+parameters to override the configuration in the file.
+
+Classes must provide a C<configfile> method which lists the default paths
+for configuration files.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>, L<Config::Tiny>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/Loader.pm

+package CRM::CARE::Trait::Loader;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use DBI;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+with 'CRM::CARE::Trait::WithDefaultConnection';
+
+requires '_retrieve_method';
+
+sub retrieve
+{
+	my ($class, @x) = @_;
+	my ($care,  @params) = $class->process_method_arguments(@x);
+	
+	my %s_args;
+	my ($_load_method, @_load_params) = $class->_retrieve_method;
+	foreach (my $i=0; $i < scalar @_load_params; $i++)
+	{
+		$s_args{ $_load_params[$i] } = $params[$i];
+	}
+	
+	my @results = map
+		{ $class->new(%$_) }
+		$care->call_service($_load_method, %s_args);
+	return unless @results;
+	return wantarray ? @results : $results[0];
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::Loader - trait to load objects via web services
+
+=head1 SYNOPSIS
+
+ my ($contact) = CRM::CARE::Contact->retrieve(123);  # fetch
+ $contact->Surname('Longbottom');  # change surname
+ $contact->update;                 # write back via web services
+
+=head1 DESCRIPTION
+
+Provides a C<retrieve> constructor.
+
+The C<retrieve> constructor can optionally be passed an additional parameter
+before its proper parameters, specifying a CRM::CARE object to use. If none is
+provided, uses the default CRM::CARE object.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>, L<CRM::CARE::Trait::WithDefaultConnection>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/Queryable.pm

+package CRM::CARE::Trait::Queryable;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use DBI;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+requires 'sql_database';
+requires 'sql_host';
+requires 'sql_port';
+requires 'sql_username';
+requires 'sql_password';
+
+has 'dbh' => (is => 'rw', isa => 'DBI::db');
+
+sub database
+{
+	my ($self) = @_;
+	
+	unless ($self->dbh)
+	{
+		my $dbh;
+
+		if ($^O eq 'MSWin32')
+		{
+			my $dsn = sprintf('Driver={SQL Server};Server=%s;Database=%s;UID=%s;PWD=%s;Port=%d',
+				$self->sql_host, $self->sql_database, $self->sql_username, $self->sql_password, $self->sql_port);
+			$dbh = DBI->connect("dbi:ODBC:$dsn", $self->sql_username, $self->sql_password, {AutoCommit=>1});
+		}
+		else
+		{
+			my $dsn = sprintf('dbi:Sybase:server=%s;host=%s;database=%s',
+				$self->sql_host, $self->sql_host, $self->sql_database);
+			$dbh = DBI->connect($dsn, $self->sql_username, $self->sql_password);
+		}
+
+		$self->dbh($dbh);
+	}
+	
+	return $self->dbh;
+}
+
+sub query
+{
+	my ($self, $sql, @params) = @_;
+	
+	my $sth = $self->database->prepare($sql);
+	$sth->execute(@params);
+	return $sth;
+}
+
+sub execute
+{
+	my ($self, $sql, @params) = @_;
+	$self->database->prepare($sql)->execute(@params);
+	return;
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::Queryable - trait to provide SQL query methods
+
+=head1 DESCRIPTION
+
+Provides C<database> (returning database handle), C<query> (returning
+statement handle) and C<execute> (not returning anything) methods.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/Updater.pm

+package CRM::CARE::Trait::Updater;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use DBI;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+	with 'CRM::CARE::Trait::WithDefaultConnection';
+
+requires '_update_method';
+
+sub update
+{
+	my ($self, @x) = @_;
+	my ($care,  %params) = $self->process_method_arguments(@x);
+
+	my %s_args;
+	my ($_save_method, @_save_params) = $self->_update_method;
+	PARAM: foreach my $sp (@_save_params)
+	{
+		if (ref $sp eq 'ARRAY')
+		{
+			my $meth = $sp->[0];
+			next PARAM unless defined $self->$meth;
+			$s_args{$sp->[1]} = $self->$meth;
+		}
+		else
+		{
+			next PARAM unless defined $self->$sp;
+			$s_args{$sp} = $self->$sp;
+		}
+	}
+	
+	return $care->call_service($_save_method, %s_args);
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::Updater - trait to update objects via web services
+
+=head1 SYNOPSIS
+
+ my ($contact) = CRM::CARE::Contact->retrieve(123);  # fetch
+ $contact->Surname('Longbottom');  # change surname
+ $contact->update;                 # write back via web services
+
+=head1 DESCRIPTION
+
+Provides an C<update> method.
+
+The C<update> method can optionally be passed an parameter specifying a
+CRM::CARE object to use. If none is provided, uses the default CRM::CARE
+object.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>, L<CRM::CARE::Trait::WithDefaultConnection>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/Validable.pm

+package CRM::CARE::Trait::Validable;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use DateTime;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+use CRM::CARE::TypeLibrary ':all';
+
+has 'ValidFrom'  => (is => 'rw', isa => 'CareDate', coerce => 1);
+has 'ValidTo'    => (is => 'rw', isa => 'CareDate', coerce => 1);
+
+sub is_current
+{
+	my ($self, $when) = @_;
+	$when //= DateTime->now;
+	
+	return
+		if (defined $self->ValidFrom and $when < $self->ValidFrom);
+	
+	return
+		if (defined $self->ValidTo and $when > $self->ValidTo);
+	
+	return $self;
+}
+
+sub is_future
+{
+	my ($self, $when) = @_;
+	$when //= DateTime->now;
+	
+	return $self
+		if (defined $self->ValidFrom and $when > $self->ValidFrom);
+	
+	return;
+}
+
+sub is_historic
+{
+	my ($self, $when) = @_;
+	$when //= DateTime->now;
+	
+	return $self
+		if (defined $self->ValidTo and $when < $self->ValidTo);
+	
+	return;
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::Validable - trait for handling validity dates
+
+=head1 SYNOPSIS
+
+ foreach my $adr ($contact->addresses)
+ {
+   print $adr->AddressNumber."\n"
+     if $adr->is_current;
+ }
+
+=head1 DESCRIPTION
+
+Provides C<ValidTo> and C<ValidFrom> attributes. These return DateTime
+objects.
+
+Provides C<is_current>, C<is_historic> and C<is_future> methods. Each of
+these can be passed an optional DateTime object to influence when "now" is
+taken to be.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>, L<DateTime>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/WebServices.pm

+package CRM::CARE::Trait::WebServices;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use CRM::CARE::Exception::WebServices;
+use HTML::Entities qw[encode_entities];
+use SOAP::Lite;# +trace => 'all';
+use Try::Tiny;
+use XML::Simple;
+
+use namespace::clean -except => 'meta';
+
+requires 'webservice_endpoint';
+requires 'webservice_database';
+requires 'webservice_username';
+requires 'webservice_password';
+
+has soap_last_request  => (is => 'rw', isa => 'HTTP::Request');
+has soap_last_response => (is => 'rw', isa => 'HTTP::Response');
+
+our $AUTOLOAD;
+
+sub AUTOLOAD
+{
+	my ($self, @parameters) = @_;
+	if ($AUTOLOAD =~ /::([A-Z][^:]+)$/)
+	{
+		$self->call_service($1 => @parameters);
+	}
+	else
+	{
+		confess "AUTOLOAD failed.";
+	}
+}
+
+our %Simple = (
+	FindContacts      => 'ContactNumber',
+	FindDocuments     => 'DocumentNumber',
+	FindOrganisations => 'OrganisationNumber',
+	);
+	
+sub call_service_raw
+{
+	my ($self, $method, @parameters) = @_;
+	my ($xmlparam, $param) = ({}, {});
+	
+	if (exists $Simple{$method} and scalar @parameters == 1 and !ref $parameters[0])
+	{
+		$xmlparam = { $Simple{$method} => $parameters[0] };
+	}
+	elsif (ref $parameters[0] eq 'HASH')
+	{
+		$param    = shift @parameters;
+		$xmlparam = {@parameters};
+	}
+	else
+	{
+		$xmlparam = {@parameters};
+	}
+
+	$xmlparam->{Database}    ||= $self->webservice_database;
+	$xmlparam->{UserLogname} ||= $self->webservice_username;
+	
+	$param->{pXMLParams} = '<Parameters>'
+		. (join '', map { sprintf('<%s>%s</%s>', $_, encode_entities($xmlparam->{$_}), $_) } sort keys %$xmlparam)
+		. '</Parameters>';
+	
+	my $soap = SOAP::Lite
+		->uri('http://care.co.uk/webservices/')
+		->proxy($self->webservice_endpoint)
+		->on_action(sub {sprintf '%s%s', @_});
+	my @soapParams = map
+		{
+			if (blessed($param->{$_}) and $param->{$_}->isa('DateTime'))
+				{ SOAP::Data->name($_ => $param->{$_}->dmy('/')); }
+			else
+				{ SOAP::Data->name($_ => $param->{$_}); }
+		}
+		keys %$param;
+	my $r = $soap
+		->call(SOAP::Data
+			->name($method)
+			->attr({xmlns=>'http://care.co.uk/webservices/'}) 
+				=> @soapParams)
+		->result;
+
+	$self->soap_last_request($soap->transport->http_request);
+	$self->soap_last_response($soap->transport->http_response);
+
+	return $r;
+}
+
+sub call_service
+{
+	my $data = XMLin(call_service_raw(@_), SuppressEmpty=>1);
+
+	if (exists $data->{ErrorNumber})
+	{
+		CRM::CARE::Exception::WebServices->throw($data);
+	}
+
+	if (exists $data->{DataRow} and ref $data->{DataRow} eq 'ARRAY')
+	{
+		return wantarray ? @{ $data->{DataRow} } : $data->{DataRow}[0];
+	}
+	elsif (exists $data->{DataRow})
+	{
+		return wantarray ? @{ [$data->{DataRow}] } : $data->{DataRow};
+	}
+	
+	return $data;
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::WebServices - trait to provide methods to call web services
+
+=head1 SYNOPSIS
+
+ use Data::Dumper;
+ my $care = CRM::CARE->new_from_config;
+ 
+ # Call "FindContacts" service with XML parameter 'ContactNumber'.
+ print Dumper($care->call_service('FindContacts',
+   ContactNumber => 500_002));
+
+ # Shortcut using AUTOLOADing
+ print Dumper($care->FindContacts(ContactNumber => 500_002));
+ 
+ # Shortcut using AUTOLOADing and %Simple
+ print Dumper($care->FindContacts(500_002));  # same
+
+=head1 DESCRIPTION
+
+Provides C<call_service> (returning hashref or a list thereof) and
+C<call_service_raw> (returning XML string) methods.
+
+Also autoloads methods.
+
+C<<%CRM::CARE::Trait::WebServices::Simple>> allows some web service methods
+to be called without parameter names.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/Trait/WithDefaultConnection.pm

+package CRM::CARE::Trait::WithDefaultConnection;
+
+use 5.008;
+use common::sense;
+use Moose::Role;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = '0.001';
+
+our $default;
+
+sub set_default_connection
+{
+	my ($self, $conn) = @_;
+	$default = $conn;
+}
+
+sub get_default_connection
+{
+	my ($self) = @_;
+	
+	unless ($default)
+	{
+		$default = CRM::CARE->new_from_config;
+	}
+	
+	return $default;
+}
+
+sub process_method_arguments
+{
+	my ($self, @args) = @_;
+
+	if (blessed($args[0]) and $args[0]->isa('CRM::CARE'))
+	{
+		return @args;
+	}
+	
+	return ($self->get_default_connection, @args);
+}
+
+1;
+
+=head1 NAME
+
+CRM::CARE::Trait::WithDefaultConnection - trait to load objects via web services
+
+=head1 SYNOPSIS
+
+ my ($contact) = CRM::CARE::Contact->retrieve(123);  # fetch
+ $contact->Surname('Longbottom');  # change surname
+ $contact->update;                 # write back via web services
+
+OK, but where do we retrieve the contact from? Where do we update it to?
+
+=head1 DESCRIPTION
+
+This trait provides methods C<set_default_connection> and
+C<get_default_connection> which will be used by all other functions
+that make use of a default CRM::CARE object.
+
+There is also a utility method C<process_method_arguments> to be used
+by methods that want to allow an alternative non-default connection to be
+passed as their first, optional parameter.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>, L<CRM::CARE::Trait::WithDefaultConnection>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.

lib/CRM/CARE/TypeLibrary.pm

+package CRM::CARE::TypeLibrary;
+
+use 5.008;
+
+use DateTime;
+use DateTime::Format::Strptime;
+
+use MooseX::Types -declare => [qw{CareDate}];
+
+our $VERSION = '0.001';
+
+local $SIG{__WARN__} = sub { undef };
+
+subtype CareDate
+	=> as class_type('DateTime');
+
+coerce CareDate
+	=> from Str
+	=> via {
+		my $d = do {
+			if (m!^(\d{1,2})[/-](\d{1,2})[/-](\d{4})$!)
+				{ DateTime->new(year => $3, month => $2, day => $1); }
+			elsif (m!^(\d{4})-(\d{2})-(\d{2})$!)
+				{ DateTime->new(year => $1, month => $2, day => $3); }
+			elsif (m!^(today|now)$!i)
+				{ DateTime->now; }
+			elsif (m!^(yesterday)$!i)
+				{ DateTime->now->subtract(days => 1); }
+			elsif (m!^(tomorrow)$!i)
+				{ DateTime->now->add(days => 1); }
+			};
+		$d->set_formatter(DateTime::Format::Strptime->new(pattern => '%d/%m/%Y'));
+		$d;
+	};
+
+1;
+
+=head1 NAME
+
+CRM::CARE::TypeLibrary - Moose stuff
+
+=head1 DESCRIPTION
+
+There's nothing to see here. Move along.
+
+=head1 SEE ALSO
+
+L<CRM::CARE>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2011 Toby Inkster
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+package Local::TestMoose;
+
+use Data::Dumper;
+use 5.010;
+use Moose;
+
+has fluff => (is=>'rw');
+
+our $AUTOLOAD;
+
+sub AUTOLOAD
+{
+	say $AUTOLOAD;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+package main;
+
+my $ltm = Local::TestMoose->new(foo=>1);
+print "Hello\n";
+$ltm->fluff(8);
+$ltm->FooBar;
+print "World\n";
+
+use lib 'inc';
+use Test::More tests => 1;
+use Test::Signature;
+signature_ok();
+use Test::More tests => 1;
+BEGIN { use_ok('Example::Example') };
+
+#!/usr/bin/perl
+
+use 5.008;
+use lib "lib";
+use CRM::CARE;
+use Data::Dumper;
+
+my $care = CRM::CARE->new_from_config;
+$care->database;
+
+print Dumper( $care->FindOrganisations(500_000) );
+#!/usr/bin/perl
+
+use 5.008;
+use lib "lib";
+use CRM::CARE;
+use Data::Dumper;
+use Try::Tiny;
+
+my $me = CRM::CARE::Contact->retrieve(500_002);
+$me->information;
+print Dumper( $me );
+#$me->Salutation('Darling Toby');
+#$me->update;
+#print Dumper( CRM::CARE::Contact->retrieve(500_002) );
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.