view release on metacpan or  search on metacpan

Wyrd/Services/SAK.pm  view on Meta::CPAN

	} else {
		if ($text =~ /,/) {
			return split /\s*,\s*/, $text;
		} else {
			return split /\s+/, $text;
		}
	}
}

=pod

=item (array of hashrefs) C<uniquify_by_ikey>(scalar, array of hashrefs)

given a key and an array of hashrefs, returns an array in the same order,
dropping any hashrefs with duplicate values in the given key.  Items are
evaluated in a case-insensitive manner.

=cut

sub uniquify_by_ikey {
	my ($key, @array) = @_;
	my %counts =();
	return grep {$counts{lc($_->{$key})}++ == 0} @array;
}

=pod

=item (array of hashrefs) C<uniquify_by_key>(scalar, array of hashrefs)

case sensitive version of C<uniquify_by_ikey>.

=cut

sub uniquify_by_key {
	my ($key, @array) = @_;
	my %counts =();
	return grep {$counts{$_->{$key}}++ == 0} @array;
}

=pod

=item (array of hashrefs) C<uri_escape>(scalar, array of hashrefs)

Quick and dirty shorthand for encoding a get request within a get request.

=cut

sub uri_escape {
	my $value = shift;
	$value = Apache::Util::escape_uri($value);
	$value =~ s/\&/%26/g;
	$value =~ s/\?/%3f/g;
	$value =~ s/\#/%23/g;
	return $value;
}

=pod

=item (scalar) C<normalize_href>(objectref DBL, scalar href)

Given a href-style URL, returns the full URL that is implied from the fragment.

=cut

sub normalize_href {
	my ($dbl, $fragment) = @_;
	my $req = $dbl->req;

	my $default_scheme = ($ENV{'HTTPS'} eq 'on') ? 'https' : 'http';
	my $default_hostinfo = $req->hostname;
	my $default_path = $dbl->self_path;

	my $uri =$req->parsed_uri;
	my $scheme = $uri->scheme || $default_scheme;
	my $hostinfo = $uri->hostinfo || $default_hostinfo;
	my $path = $uri->rpath || $default_path;
	$path =~ s{[^/]+$}{};

	if ($fragment =~ /^https?:/) {
		return $fragment;
	}
	elsif ($fragment =~ m#^/#) {
		return "$scheme://$hostinfo$fragment";
	} else {
		use Apache::URI;
		my $uri=$req->parsed_uri;
		return "$scheme://$hostinfo$path$fragment";
	}
}

=pod

=back

=head2 MAIL (:mail)

Quick and dirty interfaces to sendmail

=over

=item (null) C<send_mail> (hashref)

Send an email.  Assumes that the apache process is a trusted user (see
sendmail documentation).  The hash should have the following keys: to,
from, subject, and body.  Unless sendmail is in /usr/sbin, the path key
should also be set.

=cut

sub send_mail {
	my $mail = shift;
	$mail = lc_hash($mail);
	my $path = ($$mail{'path'} || '/usr/sbin');
	open (OUT, '|-', "$path/sendmail -t") || croak("Mail Failed: sendmail could not be used to send mail");
	print OUT <<__mail_end__;
From: $$mail{from}
To: $$mail{to}
Subject: $$mail{subject}

$$mail{body}

__mail_end__
	close OUT;
}

=pod

=back

=head2 Strings (:string)

String manipulations.

=over

=item (scalar) C<commify> (array)

Add commas to numbers, thanks to the perlfaq.

=cut

sub commify {
	my $number = shift;
	1 while ($number =~ s/^([-+]?\d+)(\d{3})/$1,$2/);
	return $number;
}