# -*- coding: utf-8; -*-

use warnings;
use strict;

package AVDataFile;
use Encode;
use AVTools;

my $rx_dmy = '(\d\d)\.(\d\d)\.(\d\d\d\d)';
my $rx_bullet = '[\*\+\=]';
my $rx_bullet_neg = '[^\*\+\=]';
my @bullet = ( '*', '+', '=' );


sub parse_data {
    my ($filename, $opt) = @_;

    $opt->{'encoding'} or $opt->{'encoding'} = 'utf8';
    $opt->{'type'} or $opt->{'type'} = 'detect';

    
    my $d = {};
    -f $filename or die "'$filename' is not a file.\n";

    open FILE, $filename or die "Cannot ropen $filename.\n";
    binmode FILE, "encoding($opt->{'encoding'})";

    my $state;

    if( $opt->{'type'} eq 'detect' ) {
        # try title and dashes
        my $row = <FILE>;
        $row = <FILE>;
        $opt->{'type'} = $row =~ /^-+\s*$/ ? 'series' : 'tracks';
        print "Data autodetection: $opt->{'type'}.\n";
        close FILE;
        open FILE, $filename or die "Cannot ropen $filename.\n";
        binmode FILE, "encoding($opt->{'encoding'})";
    }
    
    if( $opt->{'type'} eq 'series' )  { $state = 'pretitle'; }
    else                            { $state = 'items'; }
    
    my $captured_hash = {};
    my $lastbullet;
    my $captured;

    my $l = 0;
    
    $d->{'parts'} = [];
    
    while( <FILE> ) {
        $l ++;
        if( $state eq 'pretitle' ) {
            /^\s*$/ and next;
            $d->{'title'} = despace( $_ );
            $d->{'description'} = '';
            $state = 'posttitle';
            next;
        }
        
        if( $state eq 'posttitle' ) {
            /^-+\s*$/ or die "$filename:$l: Bad line (state=$state).\n";
            $state = 'desc';
            next;
        }
        
        if( $state eq 'desc' ) {
            if( _try_item_line( $_, $d->{'parts'}, "$filename:$l",
                                $opt->{'type'}, $captured_hash ) ) {
                # item - end of description parsing
                $state = 'items';
                $d->{'description'} = despace_para( $d->{'description'}, 1 );
            } else {
                $d->{'description'} .= $_;
            };
            next;
        }
        
        if( $state eq 'items' ) {
            _try_item_line( $_, $d->{'parts'}, "$filename:$l",
                            $opt->{'type'}, $captured_hash )
                and next;
            
            _try_item_description( $_, $d->{'parts'}[-1], "$filename:$l" )
                and next;

            $state = 'premethod';
        }
        
        if( $state eq 'premethod' || $state eq 'postmethod' ) {
            if( /^\((${rx_bullet})\)\s*$/ ) {
                $captured_hash->{$1} or die
                    "$filename:$l: bullet '$1' not needed.";
                $captured = $captured_hash->{$1};
                ( $captured->{'station'} or $captured->{'method'} )
                    and die 
                    "$filename:$l: bullet '$1' allready used.\n";
                
                $lastbullet = $1;
                $state = 'program';
                next;
            } else {
                $state = 'method';
                $lastbullet = undef;
            }
        }

        if( $state eq 'program' ) {
            if( m<^/(\d+) - (\d+), (\d\d)\.(\d\d)\.(\d\d\d\d) - (\d\d)\.(\d\d)\.(\d\d\d\d), > ) {
                $_ = "/$'";
                
                $1 == $captured->{'minn'} or 
                    die "$filename:$l: bad range start " .
                    "($1 vs $captured->{'minn'}).\n";
                $2 == $captured->{'maxn'} or 
                    die "$filename:$l: bad range end.\n";
                
                ( $captured->{'mindate'} and 
                  "$5-$4-$3" eq $captured->{'mindate'} )
                    or die "$filename:$l bad date range start" .
                    " ($5-$4-$3 vs $captured->{'mindate'}).\n";

                ( $captured->{'maxdate'} and 
                  "$8-$7-$6" eq $captured->{'maxdate'} )
                    or die "$filename:$l bad date range end" .
                    " ($8-$7-$6 vs $captured->{'mindate'}).\n";
                
                $captured->{'daterange'} = "$3.$4.$5 - $6.$7.$8";
            }
            
            m<^/([^,]+), (\d\d:\d\d\+?) \(([^\)]+)\)>
                or die "$filename:$l: bad line [B].\n";
            $_ = "$'";
            
            $captured->{'station'} = $1;
            $captured->{'time'} = $2;
            $captured->{'program'} = $3;
            
            m<^, ([^/]+)> and do {
                $captured->{'note'} = $1;
                $_ = "$'";
            };
            
            m<^\/\s*$> or die "$filename:$l bad line [C].\n";
            
            $state = 'method';
            next;
        }
        
        if( $state eq 'method' ) {
            /^\s*$/ and do { 
                $state = 'postmethod';
                next;
            };
            
            /^(${rx_bullet})\s+(\S.*)$/ or die "$filename:$l: bad line.\n";
            
            if( $lastbullet ) {
                $lastbullet eq $1 or 
                    die "$filename:$l: wrong bullet '$1', " .
                    "should be '$lastbullet'.\n";
            } else {
                $captured_hash->{$1} or die
                    "$filename:$l: bullet '$1' not needed.\n";
                $captured = $captured_hash->{$1};
                ( $captured->{'station'} or $captured->{'method'} )
                    and die 
                    "$filename:$l: bullet '$1' allready used.\n";
                
                $lastbullet = $1;
            }
            
            $captured->{'method'} and $captured->{'method'} .= '; ';
            $captured->{'method'} .= $2;
            next;
        }

         die "Wrong state $state.";
    }
    
    close FILE;
    
    foreach my $b ( keys (%{$captured_hash}) ) {
        $captured_hash->{$b}{'method'} or
            $captured_hash->{$b}{'station'} or
            die "$filename: bullet '$b' not defined.\n";
    }
    
    foreach my $p ( @{$d->{'parts'}} ) {
        $p->{'description'} = despace_para( $p->{'description'}, 1 );
    }

    if( $opt->{'type'} eq 'tracks' ) {
        foreach my $p (@{$d->{'parts'}}) {
            if( $p->{'captured'} ) {
                foreach my $c (@{$p->{'captured'}}) {
                    $c->{'method'} = $c->{'series_c'}{'method'};
                    $c->{'station'} = $c->{'series_c'}{'station'};
                    $c->{'time'} = $c->{'time'} || $c->{'series_c'}{'time'};
                    $c->{'program'} = $c->{'series_c'}{'program'};
                }
            }
        }
        
        $d = $d->{'parts'};
    } else {
        $d->{'captured'} = $captured_hash;
    }

    $state eq 'method' or $state eq 'postmethod' or
        die "$filename: parsing ends in state '$state' after $l lines.";
    
    return $d;
 }

sub _try_item_description {
    my ($tx, $part, $fl ) = @_;

    $tx =~ /^\s*$/ and do {
        $part and defined( $part->{'description'} ) and 
            $part->{'description'} .= $tx;
        return 1;
    };

    $tx =~ /^\s+(\S.*)$/s and do {
        ( $part and defined( $part->{'description'} ) ) or
            die "$fl: ???";
        $part->{'description'} .= $1;
        return 1;
    };

    return 0;
}

sub _try_item_line {
    my ($tx, $parts, $fl, $type, $captured_hash ) = @_;

    my $p = {};
    my $notcaptured = 0;
    if( $type eq 'series' ) {
        if( $tx =~ /^\#\s*(\d+)\s+/ )  {
            $notcaptured = 1;
        } elsif( $tx =~ /^(\d+)\s+/ ) {
        } else { return 0; }

        $tx = "$'";
        $p->{'ord'} = $1;
    } else {
        $tx =~ /${rx_bullet}\s+${rx_dmy}/ or return 0;
    }

    if( $tx =~ /\(?${rx_bullet}/ ) {
        $_ = "$`";
        $tx = "$&$'";
    } else {
        $_ = $tx;
        $tx ='';
    }

    $p->{'description'} = '';
    $_ =~ /\s*\(([^\)]+)\)\s*$/ and do {
        $_ = "$`";
        $p->{'description'} = despace( $1 );
    };

    $_ =~ /[\)\(|${rx_bullet}/ and
        die "$fl: incorrect character '$&' in track title.\n";
    $_ =~ /${rx_dmy}/ and die
        die "$fl: date '$&' in track title.\n";


    $p->{'title'} = despace( $_ );
    $p->{'captured'} = [];

    my $bullets = {};

    my $lastcaptured;
    while(1) {
        my $cap = 1;

        if( $tx =~ /^(${rx_bullet_neg}*)\((${rx_bullet})\s+(${rx_dmy})\)/ ) {
            $cap = 0;
        } elsif( $tx =~ /^(${rx_bullet_neg}*)(${rx_bullet})\s+(${rx_dmy})/ ) {
        }
        else { last; }
        
        $tx = "$'";
        my $b = $2;
        my $dmy = $3;
        my $pre = despace( $1 );

        if( $pre ne '' ) {
            $pre =~ /^\((.*)\)$/ or die "$fl: bad note";
            $lastcaptured or die "$fl:??? $pre";
            $lastcaptured->{'note'} = $1;
        }

        $notcaptured and $cap and die "$fl:captured vs notcaptured";    


        $bullets->{$b} and die "$fl: Multiple bullets.";
        $bullets->{$b} = 1;

        my $date = AVTools::date2db($dmy);

        if( $captured_hash->{$b} ) {
            $captured_hash->{$b}{'mindate'} lt $date
                or  $captured_hash->{$b}{'mindate'} = $date;
            $captured_hash->{$b}{'maxdate'} gt $date
                or  $captured_hash->{$b}{'maxdate'} = $date;
        } else {
            $captured_hash->{$b} = { 'mindate' => $date,
                                          'maxdate' => $date };
            defined($p->{'ord'}) and $captured_hash->{$b}{'minn'} = $p->{'ord'};
        }

        defined( $p->{'ord'} ) and $captured_hash->{$b}{'maxn'} = $p->{'ord'};

        $lastcaptured = { 'series_c' => $captured_hash->{$b},
                          'date' => $date,
                          'captured' => $cap };
        push @{$p->{'captured'}}, $lastcaptured;
    }

    $tx = despace( $tx );
    if( $tx ne '' ) {
        $tx =~ /^\((.*)\)$/ or die "$fl: bad note";
        $lastcaptured or die "$fl:??? $tx";
        $lastcaptured->{'note'} = $1;
    }

    defined( $p->{'ord'} ) and do {
        ( $p->{'ord'} - 1 ) == $#{$parts} + 1 or 
            die "$fl: bad number $p->{'ord'}, " . ($#{$parts}+2) . " expected.";
    };


    push @{$parts}, $p;

    return 1;
}


sub create_data_series {
    my ($series, $tracks, $opts) = @_;
    defined( $opts->{'inline'} ) or $opts->{'inline'} = 1;


    my $series_c = $series->{'captured'} || {};
    
    # head - title and description
    $series->{'title'} = despace( $series->{'title'} );
    $series->{'description'} = despace_para( $series->{'description'} );

    my $ndata = $series->{'title'} . "\n" .
        ( '-' x length( $series->{'title'} ) ) ."\n\n";

    $series->{'description'} and 
        $ndata .= formatx( $series->{'description'}, 80 ) . "\n\n";

    # determine maximum track title (possible with description) length
    my $len = prepare_tracks( $tracks, $opts->{'inline'} );

    # iterate tracks
    my $num = $#{$tracks} + 1;
    my $nn = $num > 9 ? "00" : "0";

    foreach my $t ( @{$tracks} ) {
        $nn ++;
        $t->{'ord'} == "$nn" or die "Wrong order."; # quotes to preserve "00"


        if( $t->{'captured'} ) {
            foreach my $tc ( @{$t->{'captured'}} ) {
                my $sc = ref( $tc->{'series_c'} ) ? $tc->{'series_c'} :
                    $series_c->{$tc->{'series_c'}} or die;
                $sc->{'minn'} or $sc->{'minn'} = $nn;
                $sc->{'maxn'} = $nn;
                $sc->{'mindate'} or $sc->{'mindate'} = $tc->{'date'};
                $sc->{'maxdate'} = $tc->{'date'};
            }
        }
    }

    # choose 'bullets' for captured info
    my $bl = 0;
    foreach my $v ( sort { $a->{mindate} cmp $b->{mindate} }
                    values( %{$series_c} ) ) {
        $v->{'bullet'} = $bullet[$bl++] or
            die "Too much captured for one series.";
    }
   

    $nn = $num > 9 ? "00" : "0";
    foreach my $t ( @{$tracks} ) {
        $nn ++;
        $t->{'ord'} == "$nn" or die "Wrong order."; # quotes to preserve "00"
        
        
        if( $t->{'captured'} ) {
            foreach my $tc ( @{$t->{'captured'}} ) {
                my $sc = ref( $tc->{'series_c'} ) ? $tc->{'series_c'} :
                    $series_c->{$tc->{'series_c'}} or die;
                $tc->{'bullet'} = $sc->{'bullet'};
            }
        }
        
        $ndata .= format_item( $t, $len, $nn );
    }

    $ndata =~ s/\n+$/\n/;

    # iterate capture info
    foreach my $v ( sort { $a->{mindate} cmp $b->{mindate} }
                    values( %{$series_c} ) ) {
        $ndata .= format_captureinfo( $v );
    }

    $ndata;
}

# ------------------------------------------------------------------------------

sub create_data_tracks {
    my ($tracks) = @_;

    my $ndata = '';

    # determine maximum track title  length
    prepare_tracks( $tracks );

    # iterate tracks

    my $cinfos = {};
    my @cinfos = ();
    my $bullets = {};
    my @bullet_ready = @bullet;
    
    foreach my $t ( @{$tracks} ) {
        if( $t->{'captured'} ) {
            foreach my $tc ( @{$t->{'captured'}} ) {
                my $ci = format_captureinfo( $tc, '*', {'note'=>0} );
                if( !defined( $cinfos->{$ci} ) ) {
                    $#bullet_ready >= 0 or die "Too much captured.";
                    $cinfos->{$ci} = format_captureinfo( $tc, $bullet_ready[0],
                        {'note'=>0} );
                    push @cinfos, $cinfos->{$ci};
                    $bullets->{$ci} = $bullet_ready[0];
                    shift @bullet_ready;
                }
                $tc->{'bullet'} = $bullets->{$ci};
            }
        }

        $ndata .= format_item( $t, 0 );
    }

    $ndata =~ s/\n+$/\n/;

    foreach my $ci ( @cinfos ) {
        $ndata .= $ci;
    }

    $ndata;
}

# ------------------------------------------------------------------------------
# determine maximum track title (possible with description) length
sub prepare_tracks {
    my ($tracks, $inline) = @_;
    my $len = 0;
    foreach my $t ( @{$tracks} ) {
        foreach my $k ( qw( title description note ) ) {
            $t->{$k} = despace( $t->{$k} );
            defined( $t->{$k} ) or $t->{$k} = '';
        }

        if( $inline and $t->{'description'}  and 
            length( $t->{'description'} . $t->{'title'} ) < 60 ) {
            $t->{'title'} and $t->{'title'} .= ' ';
            $t->{'title'} .= '(' . $t->{'description'} . ')';
            $t->{'description'} = '';
        }

        $t->{'title'} and $t->{'title'} .= ' ';

        my $l = length( $t->{'title'} );
        $l > $len and $len = $l;
    }

    return $len;
}


sub format_item {
    my ($t, $maxlen, $n) = @_;

    $n = $n ? "$n " : '';
    my $tx_captured = '';
    my $tx_nocaptured = '';

    for my $tc ( @{$t->{'captured'}} ) {
        defined( $tc->{'bullet'} ) or   die 'No bullet for captured item';

        $_ = $tc->{'bullet'} . " " . AVTools::db2date( $tc->{'date'} );
        $tc->{'note'} and $_ .= " ($tc->{'note'})";
        if( $tc->{'captured'} ) {
            $tx_captured .= " $_";
        } else {
            $tx_nocaptured .= " ($_)";
        }
    }

    my $tx = ($tx_captured ? '' : '# ' ) .
        sprintf( "$n%-${maxlen}s", $t->{'title'} ) .
        $tx_captured . $tx_nocaptured;

    $tx =~ s/\s+$//;
    $tx .= "\n";

    $t->{'description'} and $tx .= 
        formatx( $t->{'description'}, 78, '  ' ) . "\n\n";

    return $tx;
}

sub format_captureinfo {
    my ($ci, $bullet, $opt) =  @_;
    $opt or $opt = {};

    $bullet or $bullet = $ci->{'bullet'};

    foreach my $k ( qw( station program note ) ) {
        $ci->{$k} = despace( $ci->{$k} );
    }

    my $ndata = sprintf "\n($bullet)\n/";

    if( $ci->{'minn'} ) { # numrange, daterange
        $ndata .= "$ci->{'minn'} - $ci->{'maxn'}, " .
            AVTools::db2date( $ci->{'mindate'} ) . ' - ' .
            AVTools::db2date( $ci->{'maxdate'} ) . ', ';
    }

    $ndata .= "$ci->{'station'}, $ci->{'time'} ($ci->{'program'})";
    
    if( $opt->{'note'} || !defined( $opt->{'note'} ) ) {
        $ci->{'note'} and $ndata .= ", $ci->{'note'}";
    }
    $ndata .= "/\n";
    
    foreach my $m (split( ';', $ci->{'method'} ) ) {
        $ndata .= "$bullet " . despace( $m ) . "\n";
    }

    $ndata;
}

 
sub despace {
    my ($tx, $do_undef) = @_;

    $tx or return $tx;

    $tx =~ s/^\s*//;
    $tx =~ s/\s*$//;

    $tx =~ s/\s+/ /sg;

    $do_undef and $tx eq '' and $tx = undef;
    $tx;
}

sub despace_para {
    my ($tx, $do_undef) = @_;

    $tx or return $tx;

    $tx =~ s/^\s*//;
    $tx =~ s/\s*$//;


    my @tx = split( /\n\s*\n/, $tx );
    foreach my $tx (@tx) {
        $tx =~ s/^\s*//;
        $tx =~ s/\s*$//;
        $tx =~ s/\s+/ /sg;
    }

    $tx = join( "\n\n", @tx );
    $do_undef and $tx eq '' and $tx = undef;
    $tx;
}


sub formatx {
    my ($tx, $n, $pfx) = @_;
    
    my $acc = '';
    my $res = '';
    my $sep = '';
    $pfx or $pfx = '';

    foreach my $w (split( /\s+/, $tx ) ) {
        if( length( "$acc$sep$w" ) > $n ) {
            $res and $res .= "\n";
            $res .= "$pfx$acc";
            $acc = $w;
        } else {
            $acc .= $sep . $w;
        }
        $sep = ' ';
    }
            
    $res and $res .= "\n";
    $res .= $pfx . $acc;

    return $res;
}

1;
