Display traffic information for various RATP reseau: métro, RER and tramway

ratp-trafic.pl

#!/usr/bin/env perl
#=============================================================================
#
#         FILE: ratp-trafic.pl
#
#        USAGE: ./ratp-trafic.pl [options] [lines]
#
#  DESCRIPTION: Check RATP reseau status
#
#      OPTIONS: -raw: Display JSON formated data.
#               -status: Don't display information, just change exit status.
# REQUIREMENTS: Perl 5.10; JSON; LWP::UserAgent; Term::ANSIColor
#         BUGS: none known
#       AUTHOR: nemunaire <nemunaire@nemunai.re>
#      CREATED: 05/22/2014 07:42:00 PM
#=============================================================================

use v5.10;
use strict;
use warnings;
use utf8;
use open IO => ':utf8';
use open ':std';

use Getopt::Long;
use HTTP::Request::Common qw(GET);
use JSON;
use LWP::UserAgent;
use Pod::Usage;
use Term::ANSIColor;

### GLOBALS #############################################################

use constant API_URL => "http://www.ratp.fr/meteo/ajax/data";

our $VERSION = 1.6;


### COMMAND-LINE #############################################################

my $RAW		= undef;
my $STATUS	= 0;
my $DETAILS	= 0;
my $HELP	= 0;
my @LINES;

GetOptions(
    'raw=s{0,1}'	=> \$RAW,
    'status'		=> \$STATUS,
    'help|?'		=> \$HELP,
    ) or pod2usage(2);

pod2usage( -exitval => 0, -verbose => 2 ) if $HELP;


### FUNCTIONS ################################################################

my $_cached_weather;

sub getWeather() {
    return $_cached_weather if defined $_cached_weather;

    my $ua = LWP::UserAgent->new;
    my $req = GET API_URL;

    $_cached_weather = decode_json $ua->request($req)->content;

    $_cached_weather
}

sub getReseau($) {
    my $weather = getWeather()->{status};
    my $kind = shift;

    if (exists $weather->{ $kind }) {
	return $weather->{ $kind };
    } else {
	return undef;
    }
}

sub getStatus($$) {
    my $weather = getWeather()->{status};
    my $kind = shift;
    my $s = shift;

    if (exists $weather->{ $kind }{ lines }{ $s }) {
	return $weather->{ $kind }{ lines }{ $s };
    } else {
	return undef;
    }
}

sub displayStatus($$$) {
    my $reseau = getReseau(shift);
    my $name = shift;
    my $status = shift;

    if ($status) {
	my $color = "green"; # « infos »

	$color = "blue" if $status->{level} > 10;
	$color = "red" if $status->{level} >= 20;
	$color = "magenta" if $status->{level} >= 30;

	return colored("$reseau->{name} $name:", "bold", $color).colored(" $status->{message}", $color);
    } else {
	return "$name: unknown line"
    }
}


### MAIN ################################################################

# arguments not starting with - should be lines
while ($#ARGV >= 0) {
    push @LINES, shift @ARGV;
}
@LINES = (1 .. 14) if @LINES < 1;

if (! -t STDIN) {
    $ENV{'ANSI_COLORS_DISABLED'} = 1;
}

my $exit_status = 0;

for my $line (@LINES)
{
    my $reseau;
    my $st;
    if ($line =~ /^[A-Z]$/) {
	$reseau = "rer";
    } elsif ($line =~ /^T([0-9]+[a-z]?)$/) {
	$reseau = "tram";
    } elsif ($line =~ /^M?([0-9]+b?)$/) {
	$reseau = "metro";
	$line = $1;
    } else {
	warn "'$line' isn't a valid line.";
	next;
    }

    $st = getStatus($reseau, $line);

    $exit_status = 1 if $st && $st->{level} >= 20;

    if (defined $RAW) {
	$st->{name} = $line if ! exists $st->{name};
	$st->{message} = "unknown line" if ! exists $st->{message};
	if ($RAW eq "lines") {
	    for my $k ("name", "level", "message") {
		say $st->{$k} if defined $st->{$k};
	    }
	} else {
	    say to_json($st);
	}
    } elsif (! $STATUS) {
	say displayStatus($reseau, $line, $st);
    }
}

exit $exit_status;

__END__

=head1 NAME

RATP status - Display line status for metro, tramway and RER.

=head1 SYNOPSIS

    ./ratp-trafic.pl [OPTIONS] [LINES]

=head1 OPTIONS

=over

=item B<-help>

Displays the help.

=item B<-raw>

Display JSON formated data.

=item B<-status>

Don't display normal information, just change exit status.

=back

=head1 LINES

=over

=item B<Metro>

A single number (can be preceded by a C<M>) (and a C<b> for M3b/M7b) will be considered as métro line.

=item B<RER>

A single letter will be considered as RER line.

=item B<Tramway>

A C<T> followed by a number (and letter for T3a/T3b line) will be considered as Tramway line.

=back

=head1 EXIT STATUS

This script returns 0 when no problem (railsworks are not considered as problem) else it returns 1.

=head1 DEPENDENCIES

=over

=item

perl >= 5.10

=item

JSON v2.590.0+

=item

LWP::UserAgent

=item

Term::ANSIColor v5.001+

=back

=head1 AUTHOR

nemunaire <nemunaire@nemunai.re>

=head1 VERSION

This is B<ratp-trafic.pl> version 1.6.

=head1 CHANGELOG

=over

=item B<Version 1.6>

Use details from RATP API, don't use fabernovel bridge anymore.

=item B<Version 1.5>

If not attached to a TTY, don't output with colors.

=item B<Version 1.4>

Fix JSON charset encoding

=item B<Version 1.3>

Real JSON output for -raw option.
Perl review (minimal Perl version, JSON) thanks to thilp@cpan.org.

=item B<Version 1.2>

Add critical and infos status, picked from CSS.

=item B<Version 1.1>

Fix line matching for detailled status.

=back

=head1 LICENSE AND COPYRIGHT

B<The GNU GPLv3 License>

Copyright (C) 2014  nemunaire

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.