#!/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/&/&/g; $text =~ s//>/g; $text =~ s/\x00//g; $text =~ s/['"]/_/g; # XML parser does not accept input which contains """ or "'" $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" Search for an entry Enter a search keyword $current_url?search=1 Keyword keyword EOD ], ]; } my $title = length $keyword ? 'Search Result' : 'External Directory'; if ($args{end}) { return [ '200', [ 'Content-Type' => 'text/xml; charset="ISO-8859-1"' ], [ <<"EOD" $title No more entries 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" $title $text 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"; $name $telephone EOD } return [ '200', [ 'Content-Type' => 'text/xml; charset="ISO-8859-1"', 'Refresh' => "0; url=$next_url", ], [ <<"EOD" $title Select an entry $directories EOD ] ]; };