view release on metacpan or  search on metacpan

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

=head2 format_boolean

 my $string = $s->format_boolean($value);

Returns Yes for true value, No for false value, and '' for empty value.

=cut

	my $s = shift;
	my $value = shift;

	return $value if ($value eq '');
	return 'Yes' if ($value);
	return 'No' if (!$value);
}

sub format_percent {

=head2 format_percent

 my $string = $s->format_percent($number);

Given 0.123, returns 12.3%.

=cut

	my $s = shift;
	my $number = shift;
	my $d = shift;

	$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);