hipporion/webapp/directory.psgi

#!/usr/bin/perl

use strict;
use warnings;
use utf8;
use feature 'unicode_strings';

use Encode;
use Text::Unidecode;
use URI::Escape;

my %directory;
open my $fh1, '<', '/opt/ksp/www/directory.txt' or die "Cannot open file directory.txt: $!\n";
open my $fh2, '<', '/opt/ksp/www/directory_external.txt' or die "Cannot open file directory_external.txt: $!\n";
for my $fh ($fh1, $fh2) {
	while (<$fh>) {
		chomp;
		next if /^#/;
		next unless /^\s*(.*?)\s*=\s*([^=]*?)\s*$/;
		my ($key, $value) = ($1, $2);
		next unless length $key and length $value;
		$directory{decode('UTF-8', $key)} = decode('UTF-8', $value);
	}
}
close $fh1;
close $fh2;

sub search {
	my ($keyword, $page) = @_;
	my @keys = sort keys %directory;
	@keys = grep /\Q$keyword\E/i, @keys if length $keyword;
	splice @keys, 0, $page * 32;
	my $next = splice @keys, 32;
	return $next, map { $_ => $directory{$_} } @keys;
}

sub escape {
	my ($text) = @_;
	$text =~ s/&/&amp;/g;
	$text =~ s/</&lt;/g;
	$text =~ s/>/&gt;/g;
	$text =~ s/\x00//g;
	$text =~ s/['"]/_/g; # XML parser does not accept input which contains "&quot;" or "&apos;"
	$text =~ s/\x86/_/g; # IP Phone firmware crashes when input contains byte 0x86
	return $text;
}

sub string {
	return escape(encode('ISO-8859-1', $_[0], sub { unidecode(chr($_[0])) }));
}

my $app = sub {
	my ($env) = @_;

	return [ '405' ] if $env->{REQUEST_METHOD} !~ /^(?:HEAD|GET)$/;

	my %raw_args = map { (split /=/, $_, 2)[0,1] } split /&/, $env->{QUERY_STRING} // '';
	my %args = map { decode('ISO-8859-1', uri_unescape($_ // '')) } %raw_args;
	my $keyword = $args{keyword} // '';
	my $page = $args{page} // '';
	$page = 0 unless $page =~ /^[0-9]+$/;

	my $current_url = $env->{'psgi.url_scheme'} . '://' . $env->{HTTP_HOST} . $env->{PATH_INFO};

	if (not $args{search}) {
		return [
			'200',
			[ 'Content-Type' => 'text/xml; charset="ISO-8859-1"' ],
			[ <<"EOD"
<?xml version="1.0" encoding="ISO-8859-1"?>
<CiscoIPPhoneInput>
	<Title>Search for an entry</Title>
	<Prompt>Enter a search keyword</Prompt>
	<URL>$current_url?search=1</URL>
	<InputItem>
		<DisplayName>Keyword</DisplayName>
		<QueryStringParam>keyword</QueryStringParam>
		<InputFlags></InputFlags>
		<DefaultValue></DefaultValue>
	</InputItem>
</CiscoIPPhoneInput>
EOD
			],
		];
	}

	my $title = length $keyword ? 'Search Result' : 'External Directory';

	if ($args{end}) {
		return [
			'200',
			[ 'Content-Type' => 'text/xml; charset="ISO-8859-1"' ],
			[ <<"EOD"
<?xml version="1.0" encoding="ISO-8859-1"?>
<CiscoIPPhoneText>
	<Title>$title</Title>
	<Text>No more entries</Text>
</CiscoIPPhoneText>
EOD
			],
		];
	}

	my ($next, %search_result) = search($keyword, $page);

	if (not keys %search_result) {
		my $text = length $keyword ? 'No matching entry' : 'Directory is empty';
		return [
			'200',
			[ 'Content-Type' => 'text/xml; charset="ISO-8859-1"' ],
			[ <<"EOD"
<?xml version="1.0" encoding="ISO-8859-1"?>
<CiscoIPPhoneText>
	<Title>$title</Title>
	<Text>$text</Text>
</CiscoIPPhoneText>
EOD
			]
		];
	}

	my @next_args;
	push @next_args, 'search=1';
	push @next_args, "keyword=$raw_args{keyword}" if length $keyword;
	push @next_args, 'page=' . ($page+1) if $next;
	push @next_args, 'end=1' unless $next;
	my $next_url = $current_url . '?' . (join '&', @next_args);

	my $directories = '';
	foreach (sort keys %search_result) {
		my $key = $_;
		my $name = string($key);
		my $telephone = string($search_result{$key});
		$directories .= <<"EOD";
	<DirectoryEntry>
		<Name>$name</Name>
		<Telephone>$telephone</Telephone>
	</DirectoryEntry>
EOD
	}

	return [
		'200',
		[
			'Content-Type' => 'text/xml; charset="ISO-8859-1"',
			'Refresh' => "0; url=$next_url",
		],
		[ <<"EOD"
<?xml version="1.0" encoding="ISO-8859-1"?>
<CiscoIPPhoneDirectory>
	<Title>$title</Title>
	<Prompt>Select an entry</Prompt>
$directories</CiscoIPPhoneDirectory>
EOD
		]
	];
};