view release on metacpan or  search on metacpan

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

	$d = 1 unless(defined($d));

	return $number unless($number);

	$number = (sprintf "%.${d}f", $number*100).'%';

	return $number;
}

sub csv_to_array {

=head2 csv_to_array

 my @array = $s->csv_to_array($text,[$onerow]);

=cut

	my $s = shift;
	my $text = shift;
	my $onerow = shift;

	my @rows = ();
	$text =~ s/\s+$//s;
	my $row = [];
	while ($text=~ m/(  (?!")[^,\r\n]*      # Handle normal fields
					| "(?:["\\]"|[^"])*?" # Handle quoted fields, escaped quotes as "" or \"
					)(\r?\n|,|$)
					/sgx) {
		my $val = defined $1 ? $1 : '';
		my $eol = $2;

		if ($val =~ m/^"(.*)"$/s) {
			$val = defined $1 ? $1 : '';
			$val =~ s/["\\]"/"/sg;
		}

		push @{$row}, $val;

		if ((!$eol || $eol ne ',') && scalar(@{$row}) > 0) {
			push @rows, $row;
			$row = [];
			last if ($onerow);
		}

		last unless($eol);
	}

	if ($onerow) {
		return @{$rows[0]};
	}

	return @rows;
}

sub mime_type {
	my $s = shift;

	return unless($s->{r}{file_path});
	return 'text/html' if ($s->{r}{file_path} =~ m/\.html?$/i);
	return 'image/jpeg' if ($s->{r}{file_path} =~ m/\.jpg$/i);
	return 'image/png' if ($s->{r}{file_path} =~ m/\.png$/i);
	return 'image/gif' if ($s->{r}{file_path} =~ m/\.gif$/i);
	return 'text/xml' if ($s->{r}{file_path} =~ m/\.x(m|s)l$/i);
	return 'text/css' if ($s->{r}{file_path} =~ m/\.css$/i);
	return 'application/pdf' if ($s->{r}{file_path} =~ m/\.pdf$/i);
	return 'text/plain' if ($s->{r}{file_path} =~ m/\.txt$/i);
}

sub session_delete {
	my $s = shift;
	my $key = shift;

	if ($key) {
		# just delete one key
		if (defined($s->{session_data}{$key})) {
			delete $s->{session_data}{$key};
			_session_update($s);
		}
	} else {
		# delete entire session
		$s->{session_data} = undef;
		$s->db_q("
			DELETE FROM employee_sessions
			WHERE employee_id=?
			",undef,
			v => [ $s->{employee_id} ]);
	}
}

sub session_add {
	my $s = shift;
	my $key = shift;
	my $value = shift;

	my $insert = 1 unless(defined($s->{session_data}));

	$s->{session_data}{$key} = $value;
	_session_update($s,$insert);
}

sub _session_update {
	my $s = shift;
	my $insert = shift;

	Data::Dumper->Purity(1);
	Data::Dumper->Deepcopy(1);
	my $dd = Data::Dumper->new([\%{$s->{session_data}}],['$s->{session_data}']);

	if ($insert) {
		$s->db_insert('employee_sessions',{
			employee_id => $s->{employee_id},
			data => $dd->Dump(),
			});
	} else {
		$s->db_q("
			UPDATE employee_sessions SET data=?, last_update_ts=now()
			WHERE employee_id=?
			",undef,
			v => [ $dd->Dump(), $s->{employee_id} ]);
	}
}

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

			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},
			env_guser => $s->{env}{GUSER},
			env_gauth => $s->{env}{GAUTH},
			email_to => $info->{to},
			email_cc => $info->{cc},
			email_bcc => $info->{bcc},
			email_data => $data,
			});
	
		return 1;