From 5bca4819dd35226886e85adf6e6c3cebdf1fb00a Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Wed, 20 Aug 2014 18:49:36 +0200 Subject: move application from cgi directory to project root --- index.pl | 489 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 489 insertions(+) create mode 100644 index.pl (limited to 'index.pl') diff --git a/index.pl b/index.pl new file mode 100644 index 0000000..c4928b1 --- /dev/null +++ b/index.pl @@ -0,0 +1,489 @@ +#!/usr/bin/env perl +use Mojolicious::Lite; +use Cache::File; +use utf8; + +use DateTime; +use DateTime::Format::Strptime; +use List::MoreUtils qw(any); + +use App::VRR::Fakedisplay; +use Travel::Status::DE::DeutscheBahn; +use Travel::Status::DE::VRR; + +no warnings 'uninitialized'; +no if $] >= 5.018, warnings => "experimental::smartmatch"; + +our $VERSION = qx{git describe --dirty} || '0.07'; +chomp $VERSION; + +my %default = ( + backend => 'vrr', + line => q{}, + no_lines => 5, + offset => q{}, + platform => q{}, +); + +sub get_results { + my ( $backend, $city, $stop, $expiry ) = @_; + + $expiry ||= 150; + + my $cache = Cache::File->new( + cache_root => '/tmp/vrr-fake', + default_expires => "${expiry} sec", + ); + + my $sstr = ("${backend} _ ${stop} _ ${city}"); + $sstr =~ tr{a-zA-Z0-9}{_}c; + + my $results = $cache->thaw($sstr); + + if ( not $results ) { + my $status; + if ( $backend eq 'db' ) { + $status = Travel::Status::DE::DeutscheBahn->new( + station => "${stop}, ${city}", + mot => { + ice => 0, + ic_ec => 0, + d => 0, + nv => 0, + s => 1, + bus => 1, + u => 1, + tram => 1, + }, + ); + } + else { + $status = Travel::Status::DE::VRR->new( + place => $city, + name => $stop + ); + } + $results = [ [ $status->results ], $status->errstr ]; + $cache->freeze( $sstr, $results ); + } + + return @{$results}; +} + +sub handle_request { + my $self = shift; + my $city = $self->stash('city'); + my $stop = $self->stash('stop'); + + my $no_lines = $self->param('no_lines'); + my $frontend = $self->param('frontend') // 'png'; + my $errstr; + + if ( $city and $stop ) { + ( undef, $errstr ) + = get_results( $self->param('backend') // $default{backend}, + $city, $stop ); + } + + if ( not $no_lines or $no_lines < 1 or $no_lines > 40 ) { + $no_lines = $default{no_lines}; + } + + $self->stash( title => 'vrr-fakedisplay' ); + $self->stash( version => $VERSION ); + + $self->stash( params => $self->req->params->to_string ); + $self->stash( height => $no_lines * 10 ); + $self->stash( width => 180 ); + + $self->render( + 'main', + city => $city, + stop => $stop, + version => $VERSION, + frontend => $frontend, + errstr => $errstr, + title => $city + ? "departures for ${city} ${stop}" + : "vrr-fakedisplay ${VERSION}", + ); + + return; +} + +sub shorten_line { + my ($line) = @_; + + $line =~ s{ \s* S-Bahn }{}ox; + + $line =~ s{ ^ ( U | S | SB ) \K \s+ }{}ox; + $line =~ s{ ^ ( STR | Bus | RNV ) }{}ox; + + $line =~ s{ ^ \s+ }{}ox; + + return $line; +} + +sub shorten_destination { + my ( $backend, $dest, $city ) = @_; + + if ( $backend eq 'db' ) { + $city =~ s{ \s* [(] [^)]+ [)] $ }{}ox; + $dest =~ s{ \s* [(] [^)]+ [)] $ }{}ox; + $dest =~ s{ ^ (.+) , \s+ (.+) $ }{$2 $1}ox; + } + + if ( not( $dest =~ m{ Hbf $ }ix ) ) { + $dest =~ s{ ^ $city \s }{}ix; + } + + if ( length($dest) > 20 ) { + $dest =~ s{^Dortmund}{DO} + or $dest =~ s{^Duisburg}{DU} + or $dest =~ s{^Düsseldorf}{D} + or $dest =~ s{^Essen}{E} + or $dest =~ s{^Gelsenkirchen}{GE} + or $dest =~ s{^Mülheim}{MH}; + } + + $dest = substr( $dest, 0, 20 ); + + return $dest; +} + +sub get_filtered_departures { + my (%opt) = @_; + + my ( @grep_line, @grep_platform, @filtered_results ); + + my ( $results, $errstr ) + = get_results( $opt{backend}, $opt{city}, $opt{stop}, + $opt{cache_expiry} ); + + if ( $opt{filter_line} ) { + my @lines = split( qr{,}, $opt{filter_line} ); + @grep_line = map { qr{ ^ \Q$_\E }ix } @lines; + } + if ( $opt{filter_platform} ) { + @grep_platform = split( qr{,}, $opt{filter_platform} ); + } + + for my $d ( @{$results} ) { + + my $line = $d->line; + my $platform = ( split( qr{ }, $d->platform ) )[-1]; + my $destination = $d->destination; + my $time = $d->time; + my $etr; + + if ( ( @grep_line and not( any { $line =~ $_ } @grep_line ) ) + or ( @grep_platform and not( $platform ~~ \@grep_platform ) ) + or ( $opt{hide_regional} and $line =~ m{ ^ (RB | RE | IC | EC) }x ) + ) + { + next; + } + + push( @filtered_results, $d ); + } + + return ( \@filtered_results, $errstr ); +} + +sub make_infoboard_lines { + my (%opt) = @_; + + my ( @grep_line, @grep_platform ); + my $no_lines = $opt{no_lines} // $default{no_lines}; + my $max_lines = $opt{max_lines} // 40; + my $offset = $opt{offset} // 0; + my $results = $opt{data}; + my $displayed_lines = 0; + my $want_crop = $opt{want_crop}; + my @fmt_departures; + + my $dt_now = DateTime->now( time_zone => 'Europe/Berlin' ); + my $strp_simple = DateTime::Format::Strptime->new( + pattern => '%H:%M', + time_zone => 'floating', + ); + my $strp_full = DateTime::Format::Strptime->new( + pattern => '%d.%m.%Y %H:%M', + time_zone => 'floating', + ); + + if ( $no_lines < 1 or $no_lines > $max_lines ) { + $no_lines = 40; + } + + for my $d ( @{$results} ) { + + my $line = $d->line; + my $platform = ( split( qr{ }, $d->platform ) )[-1]; + my $destination = $d->destination; + my $time = $d->time; + my $etr; + + my $dt_dep = $strp_full->parse_datetime($time) + // $strp_simple->parse_datetime($time); + my $dt; + + if ( ( $displayed_lines >= $no_lines ) + or ( $d->can('is_cancelled') and $d->is_cancelled ) ) + { + next; + } + + if ( $time =~ m{ ^ \d\d? : \d\d $ }x ) { + $dt = DateTime->new( + year => $dt_now->year, + month => $dt_now->month, + day => $dt_now->day, + hour => $dt_dep->hour, + minute => $dt_dep->minute, + second => $dt_dep->second, + time_zone => 'Europe/Berlin', + ); + } + else { + $dt = $dt_dep; + } + + my $duration = $dt->subtract_datetime($dt_now); + + if ( $duration->is_negative + or ( $duration->in_units('minutes') < $offset ) ) + { + next; + } + elsif ( $duration->in_units('minutes') == 0 ) { + $etr = 'sofort'; + } + elsif ( $duration->in_units('hours') == 0 ) { + $etr = $duration->in_units('minutes'); + } + else { + last; + } + + $destination + = shorten_destination( $opt{backend}, $destination, $opt{city} ); + $line = shorten_line($line); + + $displayed_lines++; + + push( @fmt_departures, [ $line, $destination, $etr ] ); + } + + if ( not $want_crop ) { + while ( $displayed_lines++ < $no_lines ) { + push( @fmt_departures, [ (q{}) x 3 ] ); + } + } + + return @fmt_departures; +} + +sub render_html { + my $self = shift; + my $color = $self->param('color') || '255,208,0'; + my $template = $self->param('template') || 'display'; + + my ( $raw_departures, $errstr ) = get_filtered_departures( + city => $self->stash('city'), + stop => $self->stash('stop'), + backend => scalar $self->param('backend'), + filter_line => scalar $self->param('line'), + filter_platform => scalar $self->param('platform'), + hide_regional => ( $template eq 'infoscreen' ? 0 : 1 ), + ); + + my @departures = make_infoboard_lines( + city => $self->stash('city'), + stop => $self->stash('stop'), + backend => scalar $self->param('backend'), + no_lines => scalar $self->param('no_lines'), + offset => scalar $self->param('offset'), + want_crop => scalar $self->param('want_crop'), + data => $raw_departures + ); + + for my $d (@departures) { + if ( $d->[2] and $d->[2] ne 'sofort' ) { + $d->[2] .= ' min'; + } + } + + $self->render( + $template, + title => "vrr-fakedisplay v${VERSION}", + color => [ split( qr{,}, $color ) ], + departures => \@departures, + raw => $raw_departures, + scale => $self->param('scale') || '4.3', + version => $VERSION, + ); + + return; +} + +sub render_json { + my $self = shift; + + my ( $raw_departures, $errstr ) = get_filtered_departures( + city => $self->stash('city'), + stop => $self->stash('stop'), + backend => scalar $self->param('backend'), + cache_expiry => 60, + filter_line => scalar $self->param('line'), + filter_platform => scalar $self->param('platform'), + hide_regional => 1, + ); + my @departures = make_infoboard_lines( + no_lines => scalar $self->param('no_lines'), + offset => scalar $self->param('offset'), + want_crop => scalar $self->param('want_crop'), + data => $raw_departures, + ); + + for my $d (@departures) { + if ( $d->[2] and $d->[2] ne 'sofort' ) { + $d->[2] .= ' min'; + } + } + + $self->render( + json => { + error => $errstr, + preformatted => \@departures, + raw => $raw_departures, + version => $VERSION, + } + ); + + return; +} + +sub render_image { + my $self = shift; + + my $color = $self->param('color') || '255,208,0'; + my $scale = $self->param('scale'); + + my ( $raw_departures, $errstr ) = get_filtered_departures( + city => $self->stash('city'), + stop => $self->stash('stop'), + backend => scalar $self->param('backend'), + filter_line => scalar $self->param('line'), + filter_platform => scalar $self->param('platform'), + hide_regional => 0, + ); + + my @departures = make_infoboard_lines( + city => $self->stash('city'), + stop => $self->stash('stop'), + backend => scalar $self->param('backend'), + no_lines => scalar $self->param('no_lines'), + offset => scalar $self->param('offset'), + want_crop => scalar $self->param('want_crop'), + data => $raw_departures + ); + + if ( $scale > 30 ) { + $scale = 30; + } + + if ($errstr) { + $color = '255,0,0'; + } + + my $png = App::VRR::Fakedisplay->new( + width => 180, + height => @departures * 10, + color => [ split( qr{,}, $color ) ], + scale => $scale, + ); + + if ($errstr) { + $png->draw_at( 6, '--------backend error--------' ); + $png->new_line(); + $png->new_line(); + $png->draw_at( 0, $errstr ); + } + + $self->res->headers->content_type('image/png'); + for my $d (@departures) { + + my ( $line, $destination, $etr, undef ) = @{$d}; + + $png->draw_at( 0, $line ); + $png->draw_at( 25, $destination ); + + if ( length($etr) > 2 ) { + $png->draw_at( 145, $etr ); + } + elsif ( length($etr) > 1 ) { + $png->draw_at( 148, $etr ); + } + else { + $png->draw_at( 154, $etr ); + } + + if ( $etr and $etr ne 'sofort' ) { + $png->draw_at( 161, 'min' ); + } + + $png->new_line(); + } + if ( @departures == 0 ) { + $png->new_line(); + $png->new_line(); + $png->draw_at( 50, 'no departures' ); + } + + $self->render( data => $png->png ); + + return; +} + +get '/_redirect' => sub { + my $self = shift; + my $city = $self->param('city'); + my $stop = $self->param('stop'); + + my $params = $self->req->params; + + $params->remove('city'); + $params->remove('stop'); + + for my $param (qw(line platform offset no_lines backend)) { + if ( not $params->param($param) + or ( $params->param($param) eq $default{$param} ) ) + { + $params->remove($param); + } + } + + my $params_s = $params->to_string; + + $self->redirect_to("/${city}/${stop}?${params_s}"); + + return; +}; + +get '/' => \&handle_request; +get '/:city/(:stop).html' => \&render_html; +get '/:city/(:stop).json' => \&render_json; +get '/:city/(:stop).png' => \&render_image; +get '/:city/:stop' => \&handle_request; + +app->config( + hypnotoad => { + listen => ['http://*:8091'], + pid_file => '/tmp/vrr-fake.pid', + workers => $ENV{DBFAKEDISPLAY_WORKERS} // 2, + }, +); + +app->types->type( json => 'application/json; charset=utf-8' ); +app->start(); -- cgit v1.2.3