view release on metacpan or  search on metacpan

lib/RDF/Crypt/Role/DoesEncrypt.pm  view on Meta::CPAN

BEGIN {
	$RDF::Crypt::Role::DoesEncrypt::AUTHORITY = 'cpan:TOBYINK';
	$RDF::Crypt::Role::DoesEncrypt::VERSION   = '0.002';
}

requires 'encrypt_bytes';

sub encrypt_text
{
	my ($self, $text) = @_;
	$self->encrypt_bytes(
		encode('utf-8', $text),
	);
}

sub encrypt_model
{
	my ($self, $model, %opts) = @_;
	$model = rdf_parse(
		$model,
		%opts,
	);
	$self->encrypt_text(
		rdf_string($model, as => 'RDFXML'),
	);
}

sub send_model_by_email
{
	my ($self, $model, $mailopts, $rdfopts) = @_;
	
	confess("This object was not constructed from a WebID")
		unless $self->webid && $self->webid_model;

	my $transport;
	$transport = Mail::Transport::SMTP->new(%{$mailopts->{smtp}})
		if $mailopts->{smtp};
	$transport = Mail::Transport::Sendmail->new(%{$mailopts->{sendmail}})
		if $mailopts->{sendmail};
	$transport ||= Mail::Transport::Send->new;
	
	confess("No method for sending mail.")
		unless defined $transport;

	my @results = 
		map  { substr($_, 7) }
		grep { /^mailto:.+\@.+$/i }
		map  { $_->{mbox}->value }
		RDF::Query
			-> new(sprintf 'SELECT ?mbox { <%s> foaf:mbox ?mbox } ORDER BY ASC(?mbox)', $self->webid)
			-> execute($self->webid_model)
			-> get_all;
	
	confess("No valid e-mail address found for WebID <@{[ $self->webid ]}>")
		unless @results;
	
	my $crypto = $self->encrypt_model($model, %{ $rdfopts || +{} });
	my $default_from =
		   $RDF::Crypt::SENDER
		|| $ENV{EMAIL_ADDRESS}
		|| ((getlogin||getpwuid($<)||"anonymous").'@'.Sys::Hostname::hostname);

	my %headers = %{ $mailopts->{headers} || +{} };

	my $msg = Mail::Message->build(
		To            => $results[0],
		From          => ($mailopts->{from} || $default_from),
		Subject       => ($mailopts->{subject} || 'Encrypted data'),
		'X-Mailer'    => sprintf('%s/%s', __PACKAGE__, __PACKAGE__->VERSION),
		attach        => Mail::Message::Body::Lines->new(
			data          => ["This data has been encrypted for:\n", $self->webid."\n"],
			mime_type     => 'text/plain',
			disposition   => 'inline',
		),
		attach        => Mail::Message::Body::Lines->new(
			data          => ["$crypto\n"],
			mime_type     => 'application/prs.rdf-xml-crypt;version=0',
			disposition   => 'attachment; filename="'.($mailopts->{filename}||'data.rdf-crypt').'"',
		),
		%headers
	);
	
	return unless $msg->send($transport);
	return $msg->messageId;
}

1;

__END__

=head1 NAME

RDF::Crypt::Role::DoesEncrypt - scrambling methods

=head1 DESCRIPTION

=head2 Object Methods

=over

=item C<< encrypt_model($model) >>

Returns an encrypted serialisation of the data.

The encryption works by serialising the data as RDF/XML, then
encrypting it with C<encrypt_text>.

=item C<< send_model_by_email($model, \%opts) >>

This method only works on objects that were constructed using C<new_from_webid>.
Encrypts the model for the holder of the WebID, and sends it to an address
specified in the WebID profile using foaf:mbox.

Options:

=over

=item * B<sendmail> - hashref of options for L<Mail::Transport::Sendmail>. The
mere presence of this hashref will trigger L<Mail::Transport::Sendmail> to
be used as the delivery method.