view release on metacpan or  search on metacpan

lib/Apache/SdnFw/lib/Core.pm  view on Meta::CPAN

	my %from;
	my $nodev;
	if ($info{from}) {
		$nodev = 1;
		$from{email} = $info{from};
	} else {
		%from = $s->db_q("
			SELECT *
			FROM employees_v
			WHERE employee_id=?
			",'hash',
			v => [ $s->{employee_id} ]);
	
		croak "Unknown email address for you...." unless($from{email});
	
		$info{from} = qq("$from{name}" <$from{email}>) unless($info{from});
		#$info{bcc} = qq("$from{name}" <$from{email}>);
	}

	# Check to make sure we are getting passed all the information we need;
	foreach my $key (qw(to from subject)) {
		croak "Missing '$key' parameter on sendmail call" unless($info{$key});
	}

	foreach my $key (qw(to cc bcc)) {
		# make sure and put spaces around any email addresses
		if ($info{$key}) {
			$info{$key} =~ s/,/, /g;
		}
	}

	my @attachments;
	# if we have an attachment, check all the files first
	if (defined($info{attachment})) {
		foreach my $a (@{$info{attachment}}) {
			croak "Could not find /tmp/$a" unless (-e "/tmp/$a");
			push(@attachments,$a);
		}
	}

	if ($s->{env}{DEV} && !$nodev) {
		$info{subject} .= " (normally for $info{to})";
		$info{to} = $info{from};
		delete $info{bcc};
	}

	my $data;
	$data .= "From: $info{from}\n";
	$data .= "To: $info{to}\n";
	$data .= "Cc: $info{cc}\n" if ($info{cc});
	$data .= "Bcc: $info{bcc}\n" if ($info{bcc});
	$data .= "Subject: $info{subject}\n";

	my $boundary = md5_hex("$info{from}$info{subject}".time);

	$data .= qq(Mime-Version: 1.0\n);
	$data .= qq(Content-Type: multipart/mixed;\n\tboundary="$boundary"\n);

	$data .= "\nThis is a multi-part message in MIME format.\n";
	$data .= "\n--$boundary\n";
	$data .= "Content-Type: text/plain; charset=iso-8859-1\n";
	$data .= "Content-Transfer-Encoding: 7bit\n";
	$data .= "\n$info{body}\n";

	foreach my $a (@attachments) {
		if (-e "/tmp/$a" && $a) {
			my $ct;
			$ct = 'text/html' if ($a =~ m/\.html?$/i);
			$ct = 'image/jpeg' if ($a =~ m/\.jpg$/i);
			$ct = 'image/png' if ($a =~ m/\.png$/i);
			$ct = 'image/gif' if ($a =~ m/\.gif$/i);
			$ct = 'text/xml' if ($a =~ m/\.x(m|s)l$/i);
			$ct = 'text/css' if ($a =~ m/\.css$/i);
			$ct = 'application/pdf' if ($a =~ m/\.pdf$/i);
			$ct = 'text/plain' if ($a =~ m/\.txt$/i);

			my $content;
			open F, "/tmp/$a";
			while (<F>) {
				$content .= $_;
			}
			close F;

			$data .= "\n--$boundary\n";
			$data .= qq(Content-Type: $ct; name="$a"\n);
			$data .= qq(Content-Transfer-Encoding: base64\n);
			$data .= qq(Content-Disposition: attachment; filename="$a"\n\n);
			$data .= encode_base64($content)."\n";
		}
	}

	$data .= "\n--$boundary--\n";

#	open TMP, ">/tmp/sendmail.txt";
#	print TMP $data;
#	close TMP;

	if ($from{gauth} || ($s->{env}{GUSER} && $s->{env}{GAUTH} && $s->{send_google})) {
		return if (_send_gmail($s,\%from,\%info,$data));
	}

	open (MAIL, qq(|/usr/sbin/sendmail -f $from{email} -t)) or
		croak "Could not send mail. $!";
	print MAIL $data;
	close MAIL;
}

sub _send_gmail {
	my $s = shift;
	my $from = shift;
	my $info = shift;
	my $data = shift;

	# write to the database table, then the cron job will send things out

	my $queue = $s->db_q("SELECT tablename FROM pg_tables WHERE tablename='gmail_queue'",'scalar');

	if ($queue) {
		$s->db_insert('gmail_queue',{
			gauth => $from->{gauth},
			email => $from->{email},