#!/usr/bin/perl
package App::Music::ChordPro::Songbook;
use strict;
use warnings;
use App::Music::ChordPro::Chords;
use Encode qw(decode encode);
use Carp;
sub new {
    my ($pkg) = @_;
    bless { songs => [ App::Music::ChordPro::Song->new ] }, $pkg;
}
my $def_context = "";
my $in_context = $def_context;
my $xpose;
my @used_chords;
my %used_chords;
my $re_meta;
my $diag;                       # for diagnostics
sub parsefile {
    my ( $self, $filename, $options ) = @_;
    my $fh;
    if ( ref($filename) ) {
        my $data = encode("UTF-8", $$filename);
        $filename = "__STRING__";
        open($fh, '<', \$data)
          or croak("$filename: $!\n");
    }
    else {
        open($fh, '<', $filename)
          or croak("$filename: $!\n");
    }
    push( @{ $self->{songs} }, App::Music::ChordPro::Song->new )
      if exists($self->{songs}->[-1]->{body});
    $self->{songs}->[-1]->{structure} = "linear";
    $xpose = $options->{transpose};
    @used_chords = ();
    %used_chords = ();
    App::Music::ChordPro::Chords::reset_song_chords();
    $diag->{format} = $options->{diagformat}
      || $::config->{diagnostics}->{format};
    $diag->{file} = $filename;
    # Build regex for the known metadata items.
    if ( $::config->{metadata}->{keys} ) {
        $re_meta = '^(' .
          join( '|', map { quotemeta } @{$::config->{metadata}->{keys}} )
            . ')$';
        $re_meta = qr/$re_meta/;
    }
    else {
        undef $re_meta;
    }
    while ( <$fh> ) {
        s/[\r\n]+$//;
        $diag->{line} = $.;
        $diag->{orig} = $_;
        my $line;
        if ( $options->{encoding} ) {
            $line = decode( $options->{encoding}, $_, 1 );
        }
        else {
            eval { $line = decode( "UTF-8", $_, 1 ) };
            $line = decode( "iso-8859-1", $_ ) if $@;
        }
        $_ = $line;
        #s/^#({t:)/$1/;
        next if /^#/;
        # For practical reasons: a prime should always be an apostroph.
        s/'/\x{2019}/g;
        if ( /\{(.*)\}\s*$/ ) {
            $options->{_legacy}
              ? $self->global_directive( $1, 1 )
              : $self->directive($1);
            next;
        }
        if ( $in_context eq "tab" ) {
            $self->add( type => "tabline", text => $_ );
            next;
        }
        if ( $in_context eq "grid" ) {
            $self->add( type => "gridline", $self->decompose_grid($_) );
            next;
        }
        if ( /\S/ ) {
            $self->add( type => "songline", $self->decompose($_) );
        }
        else {
            $self->add( type => "empty" );
        }
    }
    my $showgrids;
    if ( exists($self->{songs}->[-1]->{settings}->{showgrids} ) ) {
        $showgrids = $self->{songs}->[-1]->{settings}->{showgrids};
        $showgrids &&= $::config->{chordgrid}->{show} || "all";
    }
    else {
        $showgrids = $::config->{chordgrid}->{show};
    }
    if ( $showgrids ) {
        if ( $showgrids eq "user" ) {
            @used_chords =
              grep { safe_chord_info($_)->{origin} == 1 } @used_chords;
        }
        elsif ( $showgrids eq "all" ) {
        }
        else {
            @used_chords = ();  # "none"
        }
        if ( $::config->{chordgrid}->{sorted} ) {
            @used_chords =
              sort App::Music::ChordPro::Chords::chordcompare @used_chords;
        }
        $self->add( type => "chord-grids",
                    origin => "song",
                    chords => [ @used_chords ] );
    }
    # $self->{songs}->[-1]->structurize;
    return 1;
}
sub add {
    my $self = shift;
    push( @{$self->{songs}->[-1]->{body}},
          { context => $in_context,
            @_ } );
}
sub safe_chord_info {
    my ( $c ) = @_;
    my $info = App::Music::ChordPro::Chords::chord_info($c);
    return $info || { origin => 0 };
}
sub chord {
    my ( $c ) = @_;
    return $c unless length($c);
    my $parens = $c =~ s/^\((.*)\)$/$1/;
    if ( exists $used_chords{$c} ) {
        return $parens ? "($used_chords{$c})" : $used_chords{$c};
    }
    my $info = App::Music::ChordPro::Chords::chord_info($c);
    unless ( $info ) {
        do_warn("Unknown chord: $c\n");
        $info = App::Music::ChordPro::Chords::add_unknown_chord($c)
          if $::config->{chordgrid}->{auto};
    }
    my $xc = App::Music::ChordPro::Chords::transpose( $c, $xpose );
    if ( $xc ) {
        $used_chords{$c} = $xc;
    }
    else {
        $xc = $c;
    }
    push( @used_chords, $xc ) if $info;
    return $parens ? "($xc)" : $xc;
}
sub cxpose {
    my ( $t ) = @_;
    $t =~ s/\[(.+?)\]/chord($1)/ge;
    return $t;
}
sub decompose {
    my ($self, $line) = @_;
    $line =~ s/\s+$//;
    my @a = split(/(\[.*?\])/, $line, -1);
    die("Illegal line $.:\n$_\n") unless @a; #### TODO
    if ( @a == 1 ) {
        return ( phrases => [ $line ] );
    }
    shift(@a) if $a[0] eq "";
    unshift(@a, '[]') if $a[0] !~ /^\[/;
    my @phrases;
    my @chords;
    while ( @a ) {
        my $t = shift(@a);
        $t =~ s/^\[(.*)\]$/$1/;
        push(@chords, chord($t));
        push(@phrases, shift(@a));
    }
    return ( phrases => \@phrases, chords  => \@chords );
}
sub decompose_grid {
    my ($self, $line) = @_;
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    my $rest;
    my $orig;
    if ( $line =~ /(.*\|\S*)\s([^\|]*)$/ ) {
        $line = $1;
        $rest = cxpose( $orig = $2 );
    }
    my @tokens = map { chord($_) } split( ' ', $line );
    return ( tokens => \@tokens,
             $rest ? ( comment => $rest, orig => $orig ) : () );
}
sub dir_split {
    my ( $d ) = @_;
    $d =~ s/^[: ]+//;
    $d =~ s/\s+$//;
    my $dir = lc($d);
    my $arg = "";
    if ( $d =~ /^(.*?)[: ]\s*(.*)/ ) {
        ( $dir, $arg ) = ( lc($1), $2 );
    }
    $dir =~ s/[: ]+$//;
    ( $dir, $arg );
}
sub directive {
    my ($self, $d) = @_;
    my ( $dir, $arg ) = dir_split($d);
    # Context flags.
    if    ( $dir eq "soc" ) { $dir = "start_of_chorus" }
    elsif ( $dir eq "sot" ) { $dir = "start_of_tab"    }
    elsif ( $dir eq "eoc" ) { $dir = "end_of_chorus"   }
    elsif ( $dir eq "eot" ) { $dir = "end_of_tab"      }
    if ( $dir =~ /^start_of_(\w+)\s*(.*)$/ ) {
        do_warn("Already in " . ucfirst($in_context) . " context\n")
          if $in_context;
        $in_context = $1;
        my $par = $2;
        if ( $1 eq "grid" && $par && $par =~ /^(\d+)(?:x(\d+))?$/ ) {
            do_warn("Invalid grid params: $par (must be non-zero)"), return
              unless $1;
            $self->add( type => "control",
                        name => "gridparams",
                        value => [ $1, $2 ] );
        }
        else {
            do_warn("Garbage in start_of_$1: $par (ignored)\n")
              if $par;
        }
        return;
    }
    if ( $dir =~ /^end_of_(\w+)$/ ) {
        do_warn("Not in " . ucfirst($1) . " context\n")
          unless $in_context eq $1;
        $in_context = $def_context;
        return;
    }
    if ( $dir =~ /^chorus$/i ) {
        $self->add( type => "rechorus" );
        return;
    }
    # Song settings.
    my $cur = $self->{songs}->[-1];
    # Breaks.
    if ( $dir =~ /^(?:colb|column_break)$/i ) {
        $self->add( type => "colb" );
        return;
    }
    if ( $dir =~ /^(?:new_page|np|new_physical_page|npp)$/i ) {
        $self->add( type => "newpage" );
        return;
    }
    if ( $dir =~ /^(?:new_song|ns)$/i ) {
        return unless $self->{songs}->[-1]->{body};
        push(@{$self->{songs}}, App::Music::ChordPro::Song->new );
        return;
    }
    # Comments. Strictly speaking they do not belong here.
    if ( $dir =~ /^(?:comment|c|highlight)$/ ) {
        $self->add( type => "comment", text => cxpose($arg),
                    orig => $arg );
        return;
    }
    if ( $dir =~ /^(?:comment_italic|ci)$/ ) {
        $self->add( type => "comment_italic", text => cxpose($arg),
                    orig => $arg );
        return;
    }
    if ( $dir =~ /^(?:comment_box|cb)$/ ) {
        $self->add( type => "comment_box", text => cxpose($arg),
                    orig => $arg );
        return;
    }
    # Images.
    if ( $dir eq "image" ) {
        use Text::ParseWords qw(shellwords);
        my @args = shellwords($arg);
        my $uri;
        my %opts;
        foreach ( @args ) {
            if ( /^(width|height|border|center)=(\d+)$/i ) {
                $opts{lc($1)} = $2;
            }
            elsif ( /^(scale)=(\d(?:\.\d+)?)$/i ) {
                $opts{lc($1)} = $2;
            }
            elsif ( /^(center|border)$/i ) {
                $opts{lc($_)} = 1;
            }
            elsif ( /^(src|uri)=(.+)$/i ) {
                $uri = $2;
            }
            elsif ( /^(title)=(.*)$/i ) {
                $opts{title} = $1;
            }
            elsif ( /^(.+)=(.*)$/i ) {
                do_warn( "Unknown image attribute: $1\n" );
                next;
            }
            else {
                $uri = $_;
            }
        }
        unless ( $uri ) {
            do_warn( "Missing image source\n" );
            return;
        }
        $self->add( type => "image",
                    uri  => $uri,
                    opts => \%opts );
        return;
    }
    if ( $dir =~ /^(?:title|t)$/ ) {
        $cur->{title} = $arg;
        push( @{ $self->{songs}->[-1]->{meta}->{title} }, $arg );
        return;
    }
    if ( $dir =~ /^(?:subtitle|st)$/ ) {
        push(@{$cur->{subtitle}}, $arg);
        push( @{ $self->{songs}->[-1]->{meta}->{subtitle} }, $arg );
        return;
    }
    # Metadata extensions (legacy). Should use meta instead.
    # Only accept the list from config.
    if ( $re_meta && $dir =~ $re_meta ) {
        if ( $xpose && $1 eq "key" ) {
            $arg = App::Music::ChordPro::Chords::transpose( $arg, $xpose );
        }
        push( @{ $self->{songs}->[-1]->{meta}->{$1} }, $arg );
        return;
    }
    # More metadata.
    if ( $dir =~ /^(meta)$/ ) {
        if ( $arg =~ /([^ :]+)[ :]+(.*)/ ) {
            my $key = lc $1;
            my $val = $2;
            if ( $xpose && $key eq "key" ) {
                $val = App::Music::ChordPro::Chords::transpose( $val, $xpose );
            }
            if ( $re_meta && $key =~ $re_meta ) {
                # Known.
                push( @{ $self->{songs}->[-1]->{meta}->{$key} }, $val );
            }
            elsif ( $::config->{metadata}->{strict} ) {
                # Unknown, and strict.
                do_warn("Unknown metadata item: $key");
            }
            else {
                # Allow.
                push( @{ $self->{songs}->[-1]->{meta}->{$key} }, $val );
            }
        }
        else {
            do_warn("Incomplete meta directive: $d\n");
        }
        return;
    }
    return if $self->global_directive( $d, 0 );
    # Warn about unknowns, unless they are x_... form.
    do_warn("Unknown directive: $d\n") unless $d =~ /^x_/;
    return;
}
sub global_directive {
    my ($self, $d, $legacy ) = @_;
    my ( $dir, $arg ) = dir_split($d);
    my $cur = $self->{songs}->[-1];
    # Song / Global settings.
    if ( $dir eq "titles"
         && $arg =~ /^(left|right|center|centre)$/i ) {
        $cur->{settings}->{titles} =
          lc($1) eq "centre" ? "center" : lc($1);
        return 1;
    }
    if ( $dir eq "columns"
         && $arg =~ /^(\d+)$/ ) {
        $cur->{settings}->{columns} = $arg;
        return 1;
    }
    if ( $dir eq "pagetype" || $dir eq "pagesize" ) {
        $cur->{settings}->{papersize} = $arg;
        return 1;
    }
    if ( $dir =~ /^(?:grid|g)$/ ) {
        $cur->{settings}->{showgrids} = 1;
        return 1;
    }
    if ( $dir =~ /^(?:no_grid|ng)$/ ) {
        $cur->{settings}->{showgrids} = 0;
        return 1;
    }
    # Private hacks.
    if ( $d =~ /^([-+])([-\w.]+)$/i ) {
        return if $legacy;
        $self->add( type => "set",
                    name => $2,
                    value => $1 eq "+" ? 1 : 0,
                  );
        return 1;
    }
    if ( $dir =~ /^\+([-\w.]+)$/ ) {
        return if $legacy;
        $self->add( type => "set",
                    name => $1,
                    value => $arg,
                  );
        return 1;
    }
    # Formatting.
    if ( $dir =~ /^(text|chord|tab|grid|title|footer|toc)(font|size|colou?r)$/ ) {
        my $item = $1;
        my $prop = $2;
        my $value = $arg;
        return if $legacy
          && ! ( $item =~ /^(text|chord|tab)$/ && $prop =~ /^(font|size)$/ );
        $prop = "color" if $prop eq "colour";
        if ( $prop eq "size" ) {
            unless ( $value =~ /^\d+(?:\.\d+)?\%?$/ ) {
                do_warn("Illegal value \"$value\" for $item$prop\n");
                return 1;
            }
        }
        if ( $prop =~ /^colou?r$/  ) {
            my $v;
            unless ( $v = get_color($value) ) {
                do_warn("Illegal value \"$value\" for $item$prop\n");
                return 1;
            }
            $value = $v;
        }
        $self->add( type => "control",
                    name => "$item-$prop",
                    value => $prop eq 'font' ? $value : lc($value) );
        return 1;
    }
    # define A: base-fret N frets N N N N N N
    # define: A base-fret N frets N N N N N N
    # optional: base-fret N (defaults to 1)
    # optional: N N N N N N (for unknown chords)
    if ( $d =~ /^
                (define|chord) [: ]+
                ([^: ]+) [: ] \s*
                (?: base-fret \s+ (\d+) \s+ )?
                frets
                ((?: \s+ [0-9---xX])*
                     \s+ [0-9---xX])?
                \s*$
               /xi
       ) {
        my $show = $1 eq "chord";
        return if $legacy && $show;
        my @f = split(' ', $4||'');
        my $ci = { name => $2,
                   base => $3 || 1,
                   frets => [ map { $_ =~ /^\d+/ ? $_ : -1 } @f ],
                 };
        push( @{$cur->{define}}, $ci );
        if ( @f ) {
            my $res =
              App::Music::ChordPro::Chords::add_song_chord
                  ( $ci->{name}, $ci->{base} || 1, $ci->{frets} );
            if ( $res ) {
                do_warn("Invalid chord: ", $ci->{name}, ": ", $res, "\n");
                $show = 0;
            }
        }
        else {
            App::Music::ChordPro::Chords::add_unknown_chord( $ci->{name} );
        }
        if ( $show) {
            # Combine consecutive entries.
            if ( $self->{songs}->[-1]->{body}->[-1]->{type} eq "chord-grids" ) {
                push( @{ $self->{songs}->[-1]->{body}->[-1]->{chords} },
                      $ci->{name} );
            }
            else {
                $self->add( type => "chord-grids",
                            show => "user",
                            origin => "chord",
                            chords => [ $ci->{name} ] );
            }
        }
        return 1;
    }
    return;
}
sub structurize {
    my ( $self ) = @_;
    foreach my $song ( @{ $self->{songs} } ) {
        $song->structurize;
    }
}
sub get_color {
    $_[0];
}
sub msg {
    my $m = join("", @_);
    $m =~ s/\n+$//;
    my $t = $diag->{format};
    $t =~ s/\%f/$diag->{file}/g;
    $t =~ s/\%n/$diag->{line}/g;
    $t =~ s/\%l/$diag->{orig}/g;
    $t =~ s/\%m/$m/g;
    $t =~ s/\\n/\n/g;
    $t =~ s/\\t/\t/g;
    $t;
}
sub do_warn {
    warn(msg(@_)."\n");
}
package App::Music::ChordPro::Song;
sub new {
    my ( $pkg, %init ) = @_;
    bless { structure => "linear", settings => {}, %init }, $pkg;
}
sub structurize {
    my ( $self ) = @_;
    return if $self->{structure} eq "structured";
    my @body;
    my $context = $def_context;
    foreach my $item ( @{ $self->{body} } ) {
        if ( $item->{type} eq "empty" && $item->{context} eq $def_context ) {
            $context = $def_context;
            next;
        }
        if ( $context ne $item->{context} ) {
            push( @body, { type => $context = $item->{context}, body => [] } );
        }
        if ( $context ) {
            push( @{ $body[-1]->{body} }, $item );
        }
        else {
            push( @body, $item );
        }
    }
    $self->{body} = [ @body ];
    $self->{structure} = "structured";
}
1;