From 8dfc0c027758929345f428c3a24f1b9221f9c81e Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Wed, 20 Aug 2014 18:49:06 +0200 Subject: move application from cgi directory to the project root --- index.pl | 252 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 252 insertions(+) create mode 100644 index.pl (limited to 'index.pl') diff --git a/index.pl b/index.pl new file mode 100644 index 0000000..83a3e30 --- /dev/null +++ b/index.pl @@ -0,0 +1,252 @@ +#!/usr/bin/env perl +use Mojolicious::Lite; +use Cache::File; +use List::MoreUtils qw(any); +use Travel::Status::DE::DeutscheBahn; +use Travel::Status::DE::IRIS; +use Travel::Status::DE::IRIS::Stations; +use 5.014; +use utf8; + +no if $] >= 5.018, warnings => "experimental::smartmatch"; + +our $VERSION = qx{git describe --dirty} || '0.04'; + +my $refresh_interval = 180; + +sub get_results_for { + my ( $backend, $station ) = @_; + + my $cache = Cache::File->new( + cache_root => '/tmp/db-fake', + default_expires => $refresh_interval . ' sec', + ); + + # Cache::File has UTF-8 problems, so strip it (and any other potentially + # problematic chars). + my $cstation = $station; + $cstation =~ tr{[0-9a-zA-Z -]}{}cd; + + my $cache_str = "${backend}_${cstation}"; + + my $results = $cache->thaw($cache_str); + + if ( not $results ) { + if ( $backend eq 'iris' ) { + my $status = Travel::Status::DE::IRIS->new( + station => $station, + serializable => 1 + ); + $results = [ $status->results ]; + $cache->freeze( $cache_str, $results ); + } + else { + my $status + = Travel::Status::DE::DeutscheBahn->new( station => $station ); + $results = [ $status->results ]; + $cache->freeze( $cache_str, $results ); + } + } + + return @{$results}; +} + +sub handle_request { + my $self = shift; + my $station = $self->stash('station'); + my $via = $self->stash('via'); + + my @platforms = split( /,/, $self->param('platforms') // q{} ); + my @lines = split( /,/, $self->param('lines') // q{} ); + my $template = $self->param('mode') // 'multi'; + my $hide_low_delay = $self->param('hidelowdelay') // 0; + my $hide_opts = $self->param('hide_opts') // 0; + my $backend = $self->param('backend') // 'ris'; + + $self->stash( departures => [] ); + $self->stash( title => 'db-fakedisplay' ); + $self->stash( version => $VERSION ); + + if ( not( $template ~~ [qw[clean multi single]] ) ) { + $template = 'multi'; + } + + if ( not $station ) { + $self->render( $template, hide_opts => 0 ); + return; + } + + my @departures; + my @results = get_results_for( $backend, $station ); + + if ( not @results ) { + if ( $backend eq 'iris' ) { + my @candidates = map { [ "$_->[1] ($_->[0])", $_->[0] ] } + Travel::Status::DE::IRIS::Stations::get_station($station); + if (@candidates) { + $self->render( + 'multi', + stationlist => \@candidates, + hide_opts => 0 + ); + } + } + $self->render( + 'multi', + error => "Got no results for '$station'", + hide_opts => 0 + ); + return; + } + + if ( $template eq 'single' ) { + if ( not @platforms ) { + for my $result (@results) { + if ( not( $result->platform ~~ \@platforms ) ) { + push( @platforms, $result->platform ); + } + } + @platforms = sort { $a <=> $b } @platforms; + } + my %pcnt; + @results = grep { $pcnt{ $_->platform }++ < 1 } @results; + @results = sort { $a->platform <=> $b->platform } @results; + } + + for my $result (@results) { + my $platform = ( split( / /, $result->platform ) )[0]; + my $line = $result->line; + my $delay = 0; + if ($via) { + my @route = $result->route; + if ( $result->isa('Travel::Status::DE::IRIS::Result') ) { + @route = $result->route_post; + } + if ( not( any { $_ =~ m{$via}io } @route ) ) { + next; + } + } + if ( @platforms and not( any { $_ eq $platform } @platforms ) ) { + next; + } + if ( @lines and not( any { $line =~ m{^$_} } @lines ) ) { + next; + } + my ( $info, $moreinfo ); + if ( $backend eq 'iris' ) { + my $delaymsg + = join( ', ', map { $_->[1] } $result->delay_messages ); + my $qosmsg = join( ' +++ ', map { $_->[1] } $result->qos_messages ); + if ( $result->is_cancelled ) { + $info = "Fahrt fällt aus: ${delaymsg}"; + } + elsif ( $result->delay and $result->delay > 0 ) { + if ( $template eq 'clean' ) { + $info = $delaymsg; + $delay = $result->delay; + } + else { + $info = sprintf( 'Verspätung ca. %d Min.%s%s', + $result->delay, $delaymsg ? q{: } : q{}, $delaymsg ); + } + } + if ( $info and $qosmsg ) { + $info .= ' +++ '; + } + $info .= $qosmsg; + + $moreinfo = [ $result->messages ]; + } + else { + $info = $result->info; + if ($info) { + $moreinfo = [ [ 'RIS', $info ] ]; + } + } + + if ( $info eq '+0' ) { + $info = undef; + } + if ( $template eq 'clean' + and $info + and $info =~ s{ (?: ca \. \s* )? \+ (\d+) :? \s* }{}x ) + { + $delay = $1; + } + if ( $hide_low_delay and $info ) { + $info =~ s{ (?: ca\. \s* )? \+ [ 1 2 3 4 ] $ }{}x; + } + if ($info) { + $info =~ s{ (?: ca\. \s* )? \+ (\d+) }{Verspätung ca $1 Min.}x; + } + push( + @departures, + { + time => $result->time, + train => $result->train, + via => [ $result->route_interesting(3) ], + destination => $result->destination, + platform => $platform, + info => $info, + moreinfo => $moreinfo, + delay => $delay, + } + ); + } + + $self->render( + $template, + departures => \@departures, + version => $VERSION, + title => "departures for ${station}", + refresh_interval => $refresh_interval + 3, + hide_opts => $hide_opts, + ); +} + +get '/_redirect' => sub { + my $self = shift; + my $station = $self->param('station'); + my $via = $self->param('via'); + my $params = $self->req->params; + + $params->remove('station'); + $params->remove('via'); + + if ( $params->param('mode') and $params->param('mode') eq 'multi' ) { + $params->remove('mode'); + } + + for my $param (qw(platforms)) { + if ( not $params->param($param) ) { + $params->remove($param); + } + } + + $params = $params->to_string; + + if ($via) { + $self->redirect_to("/${station}/${via}?${params}"); + } + else { + $self->redirect_to("/${station}?${params}"); + } +}; + +app->defaults( layout => 'default' ); + +get '/' => \&handle_request; +get '/:station' => \&handle_request; +get '/:station/:via' => \&handle_request; +get '/multi/:station' => \&handle_request; + +app->config( + hypnotoad => { + accepts => 10, + listen => ['http://*:8092'], + pid_file => '/tmp/db-fake.pid', + workers => $ENV{VRRFAKEDISPLAY_WORKERS} // 2, + }, +); + +app->start(); -- cgit v1.2.3