summaryrefslogtreecommitdiff
path: root/cgi/index.pl
diff options
context:
space:
mode:
authorDaniel Friesel <derf@finalrewind.org>2014-08-20 18:49:36 +0200
committerDaniel Friesel <derf@finalrewind.org>2014-08-20 18:49:36 +0200
commit5bca4819dd35226886e85adf6e6c3cebdf1fb00a (patch)
treeeeddde4349108f84c8fa252e467da91c8bf3257c /cgi/index.pl
parent9d09737ac16b1f3715c38f57830b41a3269d85d9 (diff)
move application from cgi directory to project root
Diffstat (limited to 'cgi/index.pl')
-rw-r--r--cgi/index.pl489
1 files changed, 0 insertions, 489 deletions
diff --git a/cgi/index.pl b/cgi/index.pl
deleted file mode 100644
index c4928b1..0000000
--- a/cgi/index.pl
+++ /dev/null
@@ -1,489 +0,0 @@
-#!/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();