convert_ical_to_json

#!/usr/bin/env perl
# @author Robin Schneider <ypid23@aol.de>
# @licence GPLv3 <https://www.gnu.org/licenses/gpl.html>
#
# Convert all school holidays from schulferien.org (provided as ical) to a
# JSON definition which can be used inside the JavaScript library.

# my default preamble {{{
use strict;
use warnings;
use autodie;
use feature qw(say);
use utf8;
use open qw(:std :utf8);
binmode STDOUT, ':encoding(UTF-8)';
# }}}

# constant variables {{{
my $ical_overview_url = 'http://www.schulferien.org/iCal/';
my $tmp_dir_icals     = '/tmp/school_holiday_icals/';
# my @only_states       = ( 'Baden-Württemberg', 'Bayern', 'Bremen' );
# my @only_states       = ( 'Baden-Württemberg' );
# my @only_states       = ( 'Bremen' );
my @only_states = (); # if empty, all states are processed

# my @try_not_referenced_years = (0, 0);
my @try_not_referenced_years = ( 2, 3 );
# number is maximum years to try which are not referenced from the website.
# first number: years to go to past
# last number:  years to go into future
# schulferien.org is so kind and gives you an overview of the available files if one character is misspelled.
# http://www.schulferien.org/iCal/Ferien/icals/Ferien_Baden_Wuerttemberg_201x.ics
# }}}

# used libraries for this script {{{
use Data::ICal;
use Data::ICal::DateTime;
use DateTime;
use WWW::Mechanize;
use File::Path qw(make_path);
my $mech = WWW::Mechanize->new();
## aptitude install libdata-ical-perl libdatetime-set-perl libdatetime-format-ical-perl libwww-mechanize-perl
# }}}

# debugging stuff {{{
#<<< Don‘t allow perltidy to touch the following.
my %ical_urls = (
    # 'Bremen' => [
        # [
            # 'Ferien/icals/Ferien_Bremen_2012.ics',
            # 2012
        # ],
        # [
            # 'Ferien/icals/Ferien_Bremen_2013.ics',
            # 2013
        # ],
    # ],
    'Bayern' => [
        [
            'Ferien/icals/Ferien_Bayern_2012.ics',
            2014
        ],
        [
            'Ferien/icals/Ferien_Bayern_2013.ics',
            2015
        ],
    ],
    # 'Baden-Württemberg' => [
        # [
            # 'Ferien/icals/Ferien_Baden_Wuerttemberg_2013.ics',
            # 2013
        # ],
        # [
            # 'Ferien/icals/Ferien_Baden_Wuerttemberg_2014.ics',
            # 2014
        # ],
    # ],
);
#>>>
# use Data::Dumper::Simple;
# say Dumper %ical_urls;
# exit(2);
# }}}

my %final;
if ( @ARGV > 0 ) {
    say 'Read files given as parameters.';
    for my $ical_file (@ARGV) {
        parse_ical( $ical_file, 'test', 2012, \%final );
    }
}
else {
    my %ical_urls = find_ical_links($ical_overview_url);
    process_ical_urls( \%ical_urls );
}

output_json( \%final );

# function: get the list of available school holidays {{{
sub find_ical_links {
    my $ical_overview_url = shift;
    $mech->get($ical_overview_url);
    my %ical_urls;
    {
        my %first; # first valid defection per state
        my %last;  # last valid defection per state
        my @ical_urls_curr_state;
        for my $link ( $mech->links() ) {
            my $attrs    = $link->attrs();
            my $base     = $link->base();
            my $filename = $link->url();
            # say $filename;
            if (   $filename =~ /\.ics\Z/xms
                && $attrs->{onmouseover} =~ /\('iCal\sSchulferien\s(?<year>\d{4})\s(?<state_name>[^']*)'\)/xms )
            {
                my $year       = $+{year};
                my $state_name = $+{state_name};
                $filename =~ /(?<start>\AFerien\/icals\/Ferien_)(?<save_state>[\w_-]+)_(?<year>\d{4})(?<end>\.ics)\Z/xms
                  or die 'Could not get year';
                unless ( defined $first{year} ) {
                    %first = ( year => $year, state_name => $state_name, save_state => $+{save_state} );
                }
                if ( defined $last{year} and $last{year} > $year ) {
                    if ( $try_not_referenced_years[0] ) {
                        for my $try_year ( reverse $first{year} - $try_not_referenced_years[0] .. $first{year} - 1 ) {
                            unshift( @ical_urls_curr_state,
                                [ $+{start} . $first{save_state} . '_' . $try_year . $+{end}, $try_year ] );
                        }
                    }
                    if ( $try_not_referenced_years[1] ) {
                        # add not referenced years
                        for my $try_year ( $last{year} + 1 .. $last{year} + $try_not_referenced_years[1] ) {
                            push( @ical_urls_curr_state,
                                [ $+{start} . $last{save_state} . '_' . $try_year . $+{end}, $try_year ] );
                        }
                    }
                    $ical_urls{ $last{state_name} } = [@ical_urls_curr_state];
                    @ical_urls_curr_state = ();
                    %first = ( year => $year, state_name => $state_name, save_state => $+{save_state} );
                }
                push( @ical_urls_curr_state, [ $filename, $year ] );
                %last = ( year => $year, state_name => $state_name, save_state => $+{save_state} );
            } ## end if ( $filename =~ /\.ics\Z/xms...)
        } ## end for my $link ( $mech->links...)
        $ical_urls_curr_state[-1][0] =~
          /(?<start>\AFerien\/icals\/Ferien_)(?<save_state>[\w_-]+)_(?<year>\d{4})(?<end>\.ics)\Z/xms
          or die 'Could not get year';

        if ( $try_not_referenced_years[0] ) {
            for my $try_year ( reverse $first{year} - $try_not_referenced_years[0] .. $first{year} - 1 ) {
                unshift( @ical_urls_curr_state,
                    [ $+{start} . $first{save_state} . '_' . $try_year . $+{end}, $try_year ] );
            }
        }
        for my $try_year ( $last{year} + 1 .. $last{year} + $try_not_referenced_years[1] ) {
            push( @ical_urls_curr_state, [ $+{start} . $last{save_state} . '_' . $try_year . $+{end}, $try_year ] );
        }
        $ical_urls{ $last{state_name} } = [@ical_urls_curr_state];
    }
    return %ical_urls;
} ## end sub find_ical_links
# }}}

# function: process ical urls {{{
sub process_ical_urls {
    make_path $tmp_dir_icals;
    my %only_states = map { $_ => 1 } @only_states;

    my $ical_urls = shift;

  FILE:
    for my $state_name ( keys %$ical_urls ) {

      HOLIDAY_FOR_STATE:
        for my $link_arr ( @{ $ical_urls->{$state_name} } ) {
            my $filename = $link_arr->[0];
            my $year     = $link_arr->[1];
            if ( @only_states != 0 and not $only_states{$state_name} ) {
                next FILE;
            }

            $filename =~ /\AFerien\/icals\/Ferien_(?<state>[\w_-]+)_(?<year>\d{4})\.ics\Z/xms
              or die 'Could not get year';
            # $+{state} is the save version (without Unicode characters and hyphens)
            my $curr_ical_file = $tmp_dir_icals . $+{state} . '_' . $+{year} . '.ics';

            # download if necessary
            unless ( -e $curr_ical_file ) {
                my $response = $mech->get( $ical_overview_url . $filename, ':content_file' => $curr_ical_file );
                unless ( $response->is_success ) {
                    last HOLIDAY_FOR_STATE;
                }
                die "File size of $curr_ical_file is zero. You can try to delete it and start this script again."
                  unless ( -s $curr_ical_file );
            }

            parse_ical( $curr_ical_file, $state_name, $year, \%final );
        } ## end HOLIDAY_FOR_STATE: for my $link_arr ( @{ $ical_urls...})
    } ## end FILE: for my $state_name ( keys...)
} ## end sub process_ical_urls
# }}}

# function: creates the final hash {{{
sub parse_ical {
    my $curr_ical_file = shift;
    my $state_name     = shift;
    my $year           = shift;
    my $hash_ref       = shift;

    my $cal = Data::ICal->new( filename => $curr_ical_file ) or die 'Could not read file ' . $curr_ical_file;
    my @events = $cal->events();

    my $pos = -1;
    my $last_holiday_name;

  HOLIDAY_THIS_YEAR: # ical is actually sorted, don’t know why this is unsorted but I rely on it
    foreach my $event ( sort { $a->start cmp $b->start } @events ) {
        $pos++;

        my $ends_next_year = $event->start->year != $event->end->year;
        my $holiday_name   = $event->property('summary')->[0]->value;
        $holiday_name =~ s/\s[\w_-]+\z//xms; # remove state name

        my @date_range = ( $event->start->month, $event->start->day, $event->end->month, $event->end->day );

        if ( defined $hash_ref->{$state_name} ) {
            my $count = -1;
            for my $holiday ( @{ $hash_ref->{$state_name} } ) { # go through all holidays for state
                $count++;
                if ( $holiday->{name} eq $holiday_name ) {

                    if ( $event->start->month == 1 and $event->start->day == 1 ) {
                        if ( defined $holiday->{ $event->start->year - 1 }
                            and $pos == 0 )
                        {
                            # this is the part spanning the year # 2013: [ 1, 1, 1, 5 ],
                            # Modify last year …
                            $holiday->{ $event->start->year - 1 }->[-1]->[2] = $event->end->month;
                            $holiday->{ $event->start->year - 1 }->[-1]->[3] = $event->end->day;
                            $last_holiday_name                               = $holiday_name;
                            next HOLIDAY_THIS_YEAR;
                        }
                    }

                    # year already existing?
                    if ( defined $holiday->{ $event->start->year } ) {
                        if ( $last_holiday_name eq $holiday_name ) {
                            # The current holiday is defined multiple times
                            # e.g. from 04-15 to 04-20 and 04-24 to 04-27

                            push( $hash_ref->{$state_name}->[$count]->{ $event->start->year }, [@date_range] );
                            $last_holiday_name = $holiday_name;
                            next HOLIDAY_THIS_YEAR;
                        }
                        else {

                            my $holiday_ref = $holiday->{ $event->start->year };
                            # say Dumper $holiday_ref;
                            die "$holiday_name for $year in $state_name does already exist."
                              . " This script needs fixing :-(";
                        }
                    }

                    $holiday->{ $event->start->year } = [ \@date_range ];
                    $last_holiday_name = $holiday_name;
                    next HOLIDAY_THIS_YEAR;
                } ## end if ( $holiday->{name} ...)
            } ## end for my $holiday ( @{ $hash_ref...})
        } ## end if ( defined $hash_ref...)

        # this part is spanning the year # 2013: [ 1, 1, 1, 5 ],
        if ( $event->start->month == 1 and $event->start->day == 1 and $pos == 0 ) {
            # There is no previous year, ignore this holiday.
            next HOLIDAY_THIS_YEAR;
        }

        if ( defined $hash_ref->{$state_name} ) {
            push(
                $hash_ref->{$state_name},
                { name => $holiday_name, $event->start->year => [ \@date_range ], pos => $pos }
            );
        }
        else {
            $hash_ref->{$state_name} =
              [ { name => $holiday_name, $event->start->year => [ \@date_range ], pos => $pos } ];
        }
        $last_holiday_name = $holiday_name;
    } ## end foreach my $event ( sort { ...})
} ## end sub parse_ical
# }}}

# function: formats the content of the final hash as JSON {{{
sub output_json {
    my $hash_ref = shift;
    # warn Dumper($hash_ref);
    for my $state_name ( keys %$hash_ref ) {
        my $indent_level = 0;
        say q( ) x $indent_level . qq('$state_name': {);
        $indent_level += 4;
        say q( ) x $indent_level . qq('SH': [);

        $indent_level += 4;
        for my $holiday ( sort { $a->{pos} cmp $b->{pos} } @{ $hash_ref->{$state_name} } ) {
            say q( ) x $indent_level . '{';
            say q( ) x $indent_level . qq(    name: '$holiday->{name}',);
            $indent_level += 4;
            for my $year ( sort keys $holiday ) {
                if ( $year ne 'name' and $year ne 'pos' ) {
                    my $count_range = 0;
                    print q( ) x $indent_level . $year . ': [ ';
                    for my $date_range ( @{ $holiday->{$year} } ) {
                        $count_range++;
                        if ( $count_range > 1 ) {
                            print ',  ';
                        }
                        print sprintf( '%2d, %2d', $date_range->[0], $date_range->[1] ) . ', /* to */ '
                          . sprintf( '%2d, %2d', $date_range->[2], $date_range->[3] );
                    }
                    say ' ],';
                }
            }
            $indent_level -= 4;
            say q( ) x $indent_level . qq(},);
        } ## end for my $holiday ( sort ...)
        $indent_level -= 4;
        say q( ) x $indent_level . qq(],);
        $indent_level -= 4;
        say q( ) x $indent_level . qq(},);
    } ## end for my $state_name ( keys...)
} ## end sub output_json
# }}}