
=head1 NAME

Devscripts::Uscan::WatchFile - watchsources object for L<uscan>

=head1 SYNOPSIS

  use Devscripts::Uscan::Config;
  use Devscripts::Uscan::WatchFile;
  
  my $config = Devscripts::Uscan::Config->new({
    # Uscan config parameters. Example:
    destdir => '..',
  });

  # You can use Devscripts::Uscan::FindFiles to find watchfiles
  
  my $wf = Devscripts::Uscan::WatchFile->new({
      config      => $config,
      package     => $package,
      pkg_dir     => $pkg_dir,
      pkg_version => $version,
      watchfile   => $watchfile,
  });
  return $wf->status if ( $wf->status );
  
  # Do the job
  return $wf->process_lines;

=head1 DESCRIPTION

Uscan class to parse watchfiles.

=head1 METHODS

=head2 new() I<(Constructor)>

Parse watch file and creates L<Devscripts::Uscan::WatchSource> objects for
each line.

=head3 Required parameters

=over

=item config: L<Devscripts::Uscan::Config> object

=item package: Debian package name

=item pkg_dir: Working directory

=item pkg_version: Current Debian package version

=back

=head2 Main accessors

=over

=item watchSources ref to the array that contains watchSources objects

=item watch_version: format version of the watchfile

=back

=head2 process_lines()

Method that launches Devscripts::Uscan::WatchSource::process() on each watchSource.

=head1 SEE ALSO

L<uscan>, L<Devscripts::Uscan::WatchSource>, L<Devscripts::Uscan::Config>,
L<Devscripts::Uscan::FindFiles>

=head1 AUTHOR

B<uscan> was originally written by Christoph Lameter
E<lt>clameter@debian.orgE<gt> (I believe), modified by Julian Gilbey
E<lt>jdg@debian.orgE<gt>. HTTP support was added by Piotr Roszatycki
E<lt>dexter@debian.orgE<gt>. B<uscan> was rewritten in Perl by Julian Gilbey.
Xavier Guimard E<lt>yadd@debian.orgE<gt> rewrote uscan in object
oriented Perl.

=head1 COPYRIGHT AND LICENSE

Copyright 2002-2006 by Julian Gilbey <jdg@debian.org>,
2018 by Xavier Guimard <yadd@debian.org>

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 2 of the License, or
(at your option) any later version.

=cut

package Devscripts::Uscan::WatchFile;

use strict;
use Devscripts::Uscan::Downloader;
use Devscripts::Uscan::Output;
use Devscripts::Uscan::WatchSource;
use Dpkg::Version;
use File::Copy qw/copy move/;
use List::Util qw/first/;
use Moo;

with 'Devscripts::Uscan::WatchSource::Parser',
  'Devscripts::Uscan::WatchSource::Transform';

# Required new() parameters
has config      => (is => 'rw', required => 1);
has package     => (is => 'ro', required => 1);    # Debian package
has pkg_dir     => (is => 'ro', required => 1);
has pkg_version => (is => 'ro', required => 1);
has bare => (
    is      => 'rw',
    lazy    => 1,
    default => sub { $_[0]->config->bare });
has download => (
    is      => 'rw',
    lazy    => 1,
    default => sub { $_[0]->config->download });
has downloader => (
    is      => 'ro',
    lazy    => 1,
    default => sub {
        Devscripts::Uscan::Downloader->new({
            timeout => $_[0]->config->timeout,
            agent   => $_[0]->config->user_agent,
            destdir => $_[0]->config->destdir,
            headers => $_[0]->config->http_header,
        });
    },
);
has signature => (
    is       => 'rw',
    required => 1,
    lazy     => 1,
    default  => sub { $_[0]->config->signature });
has watchfile => (is => 'ro', required => 1);    # usually debian/watch

# Internal attributes
has group         => (is => 'rw', default => sub { [] });
has origcount     => (is => 'rw');
has origtars      => (is => 'rw', default => sub { [] });
has status        => (is => 'rw', default => sub { 0 });
has watch_version => (is => 'rw');
has commonOpts    => (is => 'rw', default => sub { {} });
has watchSources  => (is => 'rw', default => sub { [] });
has watchOptions  => (is => 'rw', default => sub { [] });

# Values shared between lines
has shared => (
    is      => 'rw',
    lazy    => 1,
    default => \&new_shared,
);

sub new_shared {
    return {
        bare                        => $_[0]->bare,
        components                  => [],
        common_newversion           => undef,
        common_mangled_newversion   => undef,
        download                    => $_[0]->download,
        download_version            => undef,
        origcount                   => undef,
        origtars                    => [],
        previous_download_available => undef,
        previous_newversion         => undef,
        previous_newfile_base       => undef,
        previous_sigfile_base       => undef,
        signature                   => $_[0]->signature,
        uscanlog                    => undef,
    };
}
has keyring => (
    is      => 'ro',
    default => sub { Devscripts::Uscan::Keyring->new });

sub BUILD {
    my ($self, $args) = @_;
    my $watch_version = 0;
    my $nextline;
    $dehs_tags = {};
    my $watchFileHandle;

    if ($self->config->{update_watchfile}) {
        require Devscripts::Uscan::Version4;
        eval {
            $watchFileHandle
              = Devscripts::Uscan::Version4->new($args->{watchfile},
                $self->config);
        };
        if ($@) {
            uscan_die
              "Unable to load $args->{watchfile} with Version4.pm:\n$@";
        } else {
            local $/ = undef;
            my $content = <$watchFileHandle>;
            $watchFileHandle->close;
            $watchFileHandle = undef;
            if (open $watchFileHandle, '>', $args->{watchfile}) {
                print $watchFileHandle $content;
                $watchFileHandle->close;
                uscan_warn "$args->{watchfile} is now converted to version 5.";
                uscan_warn
                  'BE CAREFUL, some default values changed in version 5, '
                  . "you shouldn't commit this without test.";
            } else {
                uscan_warn "Unable to write $args->{watchfile}: $!";
            }
        }
        return;
    }

    uscan_verbose "Process watch file at: $args->{watchfile}\n"
      . "    package = $args->{package}\n"
      . "    version = $args->{pkg_version}\n"
      . "    pkg_dir = $args->{pkg_dir}";

    $self->origcount(0);    # reset to 0 for each watch file
    unless (open $watchFileHandle, $args->{watchfile}) {
        uscan_warn "could not open $args->{watchfile}: $!";
        return 1;
    }

    eval { $self->parseWatchFile($watchFileHandle, $args) };
    my $error;
    if ($@) {
        uscan_debug "Version 5 parser returned: $@";
        # TODO: later, increase log level to uscan_warn
        uscan_verbose
          "$args->{watchfile} isn't formatted in version 5, trying version 4";
        $error = $@;
        $watchFileHandle->close;
        require Devscripts::Uscan::Version4;
        eval {
            $watchFileHandle
              = Devscripts::Uscan::Version4->new($args->{watchfile});
        };
        if ($@) {
            uscan_warn "Unable to read $args->{watchfile}:\n"
              . " - version  5: $error\n"
              . " - version <5: $@\n";
            return;
        }
        $self->parseWatchFile($watchFileHandle, $args);
        uscan_verbose 'Reset watch_version to 4 because '
          . 'default value may change in version 5';
        $self->watch_version(4);
    }
    close $watchFileHandle
      or $self->status(1),
      uscan_warn "problems reading $$args->{watchfile}: $!";

    unless ($self->transformWatchSource($args)) {
        uscan_die "Unable to read watchSource";
        return;
    }

    my $lineNumber = 0;
    foreach my $watchSource (@{ $self->watchOptions }) {
        my $line = Devscripts::Uscan::WatchSource->new({
                # Shared between lines
                config     => $self->config,
                downloader => $self->downloader,
                shared     => $self->shared,
                keyring    => $self->keyring,

                # Other parameters
                watchSource   => $watchSource,
                pkg           => $self->package,
                pkg_dir       => $self->pkg_dir,
                pkg_version   => $self->pkg_version,
                watch_version => $self->watch_version,
                watchfile     => $self->watchfile,
        });
        push @{ $self->group }, $lineNumber
          if ($line->type and $line->type =~ /^(?:group|checksum)$/);
        push @{ $self->watchSources }, $line;
        $lineNumber++;
    }
}

sub process_lines {
    my ($self) = shift;
    return $self->process_group if (@{ $self->group });
    foreach (@{ $self->watchSources }) {

        # search newfile and newversion
        my $res = $_->process;
        $self->status($res) if ($res);
    }
    return $self->{status};
}

sub process_group {
    my ($self)           = @_;
    my $saveDconfig      = $self->config->download_version;
    my $versionSeparator = $self->commonOpts->{versionseparator}
      || $self->{config}->{version_separator};
    my $rsep = qr/\Q$versionSeparator\E/;
    # Build version
    my @cur_versions = split $rsep, $self->pkg_version;
    my $checksum     = 0;
    my $newChecksum  = 0;
    if (    $cur_versions[$#cur_versions]
        and $cur_versions[$#cur_versions] =~ s/^cs//) {
        $checksum = pop @cur_versions;
    }
    my (@new_versions, @last_debian_mangled_uversions, @last_versions);
    my $download    = 0;
    my $last_shared = $self->shared;
    my $last_comp_version;
    my @dversion;
    my @ck_versions;
    # Isolate component and following lines
    if (my $v = $self->config->download_version) {
        @dversion = map { s/\+.*$//; /^cs/ ? () : $_ }
          split $rsep, $v;
    }
    foreach my $line (@{ $self->watchSources }) {
        if (
            $line->type
            and (  $line->type eq 'group'
                or $line->type eq 'checksum')
        ) {
            $last_shared       = $self->new_shared;
            $last_comp_version = shift @cur_versions if $line->type eq 'group';
        }
        if ($line->type and $line->type eq 'group') {
            $line->{groupDversion} = shift @dversion;
        }
        $line->shared($last_shared);
        $line->pkg_version($last_comp_version || 0);
    }
    # Check if download is needed
    foreach my $line (@{ $self->watchSources }) {
        next
          unless ($line->type
            and ($line->type eq 'group' or $line->type eq 'checksum'));
        # Stop on error
        $self->config->download_version($line->{groupDversion})
          if $line->{groupDversion};
        $self->config->download_version(undef) if $line->type eq 'checksum';
        if (   $line->parse
            or $line->search
            or $line->get_upstream_url
            or $line->get_newfile_base
            or ($line->type eq 'group' and $line->cmp_versions)
            or ($line->ctype and $line->cmp_versions)) {
            $self->{status} += $line->status;
            return $self->{status};
        }
        $download = $line->shared->{download}
          if $line->shared->{download} > $download
          and ($line->type eq 'group' or $line->ctype);
    }
    foreach my $line (@{ $self->watchSources }) {
        next unless $line->type and $line->type eq 'checksum';
        $newChecksum
          = $self->sum($newChecksum,
            $line->search_result->{mangled_newversion});
        push @ck_versions, $line->search_result->{mangled_newversion};
    }
    foreach my $line (@{ $self->watchSources }) {
        next unless ($line->type and $line->type eq 'checksum');
        $line->parse_result->{mangled_lastversion} = $checksum;
        my $tmp = $line->search_result->{mangled_newversion};
        $line->search_result->{mangled_newversion} = $newChecksum;
        unless ($line->ctype) {
            if ($line->cmp_versions) {
                $self->{status} += $line->status;
                return $self->{status};
            }
            $download = $line->shared->{download}
              if $line->shared->{download} > $download;
        }
        $line->search_result->{mangled_newversion} = $tmp;
        if ($line->component) {
            pop @{ $dehs_tags->{'component-upstream-version'} };
            push @{ $dehs_tags->{'component-upstream-version'} }, $tmp;
        }
    }
    foreach my $line (@{ $self->watchSources }) {
        # Set same $download for all
        $line->shared->{download} = $download;
        # Non "group" lines where not initialized
        unless ($line->type
            and ($line->type eq 'group' or $line->type eq 'checksum')) {
            if (   $line->parse
                or $line->search
                or $line->get_upstream_url
                or $line->get_newfile_base
                or $line->cmp_versions) {
                $self->{status} += $line->status;
                return $self->{status};
            }
        }
        if ($line->download_file_and_sig) {
            $self->{status} += $line->status;
            return $self->{status};
        }
        if ($line->mkorigtargz) {
            $self->{status} += $line->status;
            return $self->{status};
        }
        if ($line->type and $line->type eq 'group') {
            push @new_versions, $line->shared->{common_mangled_newversion}
              || $line->shared->{common_newversion}
              || ();
            push @last_versions, $line->parse_result->{lastversion};
            push @last_debian_mangled_uversions,
              $line->parse_result->{mangled_lastversion};
        }
    }
    my $new_version = join $versionSeparator, @new_versions;
    if ($newChecksum) {
        $new_version .= "${versionSeparator}cs$newChecksum";
    }
    if ($checksum) {
        push @last_versions,                 "cs$newChecksum";
        push @last_debian_mangled_uversions, "cs$checksum";
    }
    $dehs_tags->{'upstream-version'} = $new_version;
    $dehs_tags->{'debian-uversion'}  = join($versionSeparator, @last_versions)
      if (grep { $_ } @last_versions);
    $dehs_tags->{'debian-mangled-uversion'} = join $versionSeparator,
      @last_debian_mangled_uversions
      if (grep { $_ } @last_debian_mangled_uversions);
    my $mangled_ver
      = Dpkg::Version->new(
        "1:" . $dehs_tags->{'debian-mangled-uversion'} . "-0",
        check => 0);
    my $upstream_ver = Dpkg::Version->new("1:$new_version-0", check => 0);
    if ($mangled_ver == $upstream_ver) {
        $dehs_tags->{'status'} = "up to date";
    } elsif ($mangled_ver > $upstream_ver) {
        $dehs_tags->{'status'} = "only older package available";
    } else {
        $dehs_tags->{'status'} = "newer package available";
    }
    foreach my $line (@{ $self->watchSources }) {
        my $path = $line->destfile or next;
        my $ver  = $line->shared->{common_mangled_newversion};
        $path =~ s/\Q$ver\E/$new_version/;
        uscan_warn "rename $line->{destfile} to $path\n";
        rename $line->{destfile}, $path;
        if ($dehs_tags->{"target-path"} eq $line->{destfile}) {
            $dehs_tags->{"target-path"} = $path;
            $dehs_tags->{target} =~ s/\Q$ver\E/$new_version/;
        } else {
            for (
                my $i = 0 ;
                $i < @{ $dehs_tags->{"component-target-path"} } ;
                $i++
            ) {
                if ($dehs_tags->{"component-target-path"}->[$i] eq
                    $line->{destfile}) {
                    $dehs_tags->{"component-target-path"}->[$i] = $path;
                    $dehs_tags->{"component-target"}->[$i]
                      =~ s/\Q$ver\E/$new_version/
                      or die $ver;
                }
            }
        }
        if ($line->signature_available) {
            rename "$line->{destfile}.asc", "$path.asc";
            rename "$line->{destfile}.sig", "$path.sig";
        }
    }
    if (@ck_versions) {
        my $v = join $versionSeparator, @ck_versions;
        if ($dehs) {
            $dehs_tags->{'decoded-checksum'} = $v;
        } else {
            uscan_verbose 'Checksum ref: '
              . join($versionSeparator, @ck_versions) . "\n";
        }
    }
    return 0;
}

sub sum {
    my ($self, @versions) = @_;
    my (@res, @str);
    foreach my $v (@versions) {
        my @tmp = grep { $_ ne '.' } version_split_digits($v);
        for (my $i = 0 ; $i < @tmp ; $i++) {
            $str[$i] //= '';
            $res[$i] //= 0;
            if ($tmp[$i] =~ /^\d+$/) {
                $res[$i] += $tmp[$i];
            } else {
                uscan_die
"Checksum supports only digits in versions, $tmp[$i] is not accepted";
            }
        }
    }
    for (my $i = 0 ; $i < @res ; $i++) {
        my $tmp = shift @str;
        $res[$i] .= $tmp if $tmp ne '';
    }
    push @res, @str;
    return join '.', @res;
}

1;
