#!/usr/bin/env perl
use strict;
use warnings;
use OptArgs2;
use Path::Tiny;
use Text::vCard::Addressbook;
use Time::Piece;

our $VERSION = 'v1.1.1';

my $opts = optargs(
    comment => 'tidy (normalize) VCARD contact files',
    optargs => [
        files => {
            isa     => 'ArrayRef',
            default => sub {
                [ ( -t STDIN ) ? ( die OptArgs2::usage(__PACKAGE__) ) : '-' ]
            },
            greedy  => 1,
            comment => 'file to tidy (default is stdin)',
        },
        debug => {
            isa     => '--Flag',
            alias   => 'd',
            comment => 'output debugging information to STDERR',
        },
        force => {
            isa     => '--Flag',
            alias   => 'f',
            comment => 'insert missing fields where required',
        },
        no_rev => {
            isa     => '--Flag',
            alias   => 'R',
            comment => 'do not update REV value'
        },
        nothing => {
            isa     => '--Flag',
            alias   => 'n',
            comment => q{don't modify files, only report errors},
        },
        regex => {
            isa      => '--ArrayRef',
            isa_name => 's/OLD/NEW/',
            alias    => 'r',
            comment  => 'Replacement expression to run first',
            default  => sub { [] },
        },
        vcard_version => {
            isa     => '--Str',
            alias   => 'v',
            default => '4.0',
            comment => 'value for vCard VERSION field'
        },
        version => {
            isa     => '--Flag',
            alias   => 'V',
            comment => 'print version information and exit',
            trigger => sub {
                require File::Basename;
                die File::Basename::basename($0)
                  . ' version '
                  . $VERSION . "\n";
            },
        },
    ],
);

my $have_npl = eval { require Number::Phone::Lib; 1 };
my $dtstamp  = localtime->strftime('%Y-%m-%dT%H%M%SZ');

binmode( STDERR, ':encoding(UTF-8)' ) if $opts->{debug};

my $badcount = 0;
foreach my $f ( @{ $opts->{files} } ) {
    $opts->{input} = $f;
    vcardtidy($opts) || $badcount++;
}

die "vcardtidy failure count: $badcount\n" if $badcount;

sub vcardtidy {
    my $opts = shift;

    my $data;
    my $path;

    if ( $opts->{input} eq '-' ) {
        local $/;
        binmode STDIN, ':raw:encoding(UTF-8)';
        $data = <STDIN>;
        $path = path('-');    # for debug below
    }
    else {
        $path = path( $opts->{input} );
        $data = $path->slurp( { binmode => ':raw:encoding(UTF-8)' } );
    }

    my $filtered = $data;
    foreach my $user_re ( @{ $opts->{regex} } ) {
        use experimental 're_strict';
        use re 'strict';

        print STDERR "Regex: $user_re\n" if $opts->{debug};
        my $old = $filtered;
        eval {
            local $SIG{ALRM} = sub { die "Timeout\n" };
            alarm 1;
            eval "\$filtered =~ $user_re";
            die $@ if $@;
            alarm 0;
        };

        die "Regex failed: $user_re:" . $@ if $@;
        _diff( $old, $filtered )           if $opts->{debug};
    }

    my $ab =
      eval { Text::vCard::Addressbook->new( { 'source_text' => $filtered } ); };

    if ($@) {
        warn "$opts->{input}: $@";
        return 0;
    }

    my $vcards = $ab->vcards;
    if ( 0 == @$vcards ) {
        warn "$opts->{input}: No cards to tidy!\n";
        return 1;    # not considered an error. TODO If '-' then print?
    }

    foreach my $vcard (@$vcards) {
        my $i = 0;
        my $u = $vcard->get_simple_type('UID') // do {
            my $uid = _new_uid();
            $vcard->add_node( { 'node_type' => 'UID', } )->value($uid);
            warn qq/$opts->{input}: VCARD $i missing UID (set to "$uid")\n/;
            $uid;
        };
        $u =~ s/-.*//;

        if ( not $vcard->get('FN') ) {
            if ( $opts->{force} ) {
                $vcard->fn($u);
                warn
                  qq/$opts->{input}: VCARD $i missing FN field (set to "$u")\n/;
            }
            else {
                warn qq/$opts->{input}: VCARD $i missing FN field!\n/;
                return 0;
            }
        }

        if ( not $vcard->get('N') ) {
            if ( $opts->{force} ) {
                $vcard->add_node(
                    {
                        'node_type' => 'N',
                        data        => [ { value => $u . ';;;;' } ]
                    }
                );
                warn
                  qq/$opts->{input}: VCARD $i missing N type (set to "$u")\n/;
            }
            else {
                warn qq/$opts->{input}: VCARD $i missing N field!\n/;
                return 0;
            }
        }

        if ( my $numbers = $vcard->get('tel') ) {
            if ($have_npl) {
                local $SIG{__WARN__} = sub {
                    warn "$0 $opts->{input}: TEL: @_";
                };
                foreach my $entry (@$numbers) {
                    my $v = $entry->value();
                    $v || warn("empty entry!\n") && next;
                    my $num = Number::Phone::Lib->new($v);
                    ( $num && $num->is_valid )
                      || warn("invalid: '$v'\n") && next;
                    my $norm = $num->format_using('NationallyPreferredIntl');
                    $norm = $num->format() if $norm =~ m/NA/;
                    $entry->value($norm);
                }
            }
            @$numbers = sort { $a->as_string cmp $b->as_string } @$numbers;
        }

        my $v = $vcard->version;
        if ( not length $v ) {
            $vcard->version( $opts->{vcard_version} );
            warn qq/$opts->{input}: VCARD $i missing VERSION /
              . qq/(set to "$opts->{vcard_version}")\n/;
        }
        elsif ( $v ne $opts->{vcard_version} and $opts->{force} ) {
            $vcard->version( $opts->{vcard_version} );
            warn qq/$opts->{input}: forcing VCARD $i VERSION /
              . qq/to $opts->{vcard_version}\n/;
        }

        $vcard->REV($dtstamp) unless $opts->{no_rev};

        my $prodid_old = $vcard->PRODID // 'vcardtidy';
        $vcard->PRODID("vcardtidy $VERSION") if $prodid_old =~ m/^vcardtidy/;

        $i++;
    }

    # Sort cards by FN - in place so the export sees the changed order
    @$vcards =
      map  { $_->[0] }
      sort { $a->[1] cmp $b->[1] || $a->[2] cmp $b->[2] }
      map  { [ $_, $_->fullname, $_->UID ] } @$vcards;

    # Remove duplicate fields
    my $prev = '';
    my $seen;
    my $tidy = join '', map {
        $seen = $_ eq $prev;
        $prev = $_;
        $seen ? () : $_ . "\x0D\x0A"
    } split "\x0D\x0A", $ab->export;

    # Fix for multiple categories
    while ( $tidy =~ s/^(CATEGORIES:.*?)\\,/$1,/mg ) { }

    # Ignore changes that only appar in REV and PRODID fields
    my $data2 = $data;
    my $tidy2 = $tidy;
    foreach ( $data2, $tidy2 ) {
        s/^(REV:).*(\015\012)/$1$2/m;
        s/^(PRODID:).*(\015\012)/$1$2/m;
    }

    my $is_diff = $data2 ne $tidy2;
    my $rewrite = ( ( $opts->{force} // $is_diff ) and not $opts->{nothing} );

    if ( $opts->{debug} ) {
        print STDERR 'vcardtidy ' . $path->basename . ':';
        print STDERR $is_diff ? "\n" . _diff( $data, $tidy ) : ' no change';
        print STDERR "\n";
    }

    if ( $opts->{input} eq '-' ) {
        binmode STDOUT, ':raw:encoding(UTF-8)';
        print( $rewrite ? $tidy : $data );
    }
    elsif ($rewrite) {
        $path->spew( { binmode => ':raw:encoding(UTF-8)' }, $tidy );
    }

    1;
}

sub _new_uid {
    use feature 'state';
    state @c     = ( 'a' .. 'f', 0 .. 9 );
    state $len_c = scalar @c;
    join '-', map {
        join '',
          map { $c[ rand($len_c) ] }
          @$_
    }[ 1 .. 8 ], [ 1 .. 4 ], [ 1 .. 4 ], [ 1 .. 4 ], [ 1 .. 12 ];
}

sub _diff {
    my ( $t1, $t2 ) = @_;
    require Text::Diff;
    Text::Diff::diff( \$t1, \$t2 ) =~ s/^/    /gmr;
}

__END__

=head1 NAME

vcardtidy - normalize the format of VCARD files

=head1 VERSION

v1.1.1 (2026-11-13)

=head1 SYNOPSIS

    vcardtidy [FILES...] [OPTIONS...]

=head1 DESCRIPTION

B<vcardtidy> formats VCARD files, using L<Text::vCard::Addressbook> to
normalize field order and capitalization. If L<Number::Phone> is
installed then phone numbers are formatted using the
L<NationallyPreferredIntl|Number::Phone::Formatter::NationallyPreferredIntl>
format.

By default B<vcardtidy> acts like a filter, reading from C<stdin> and
writing to C<stdout>.

If C<FILES...> are specified they are tidied up B<in place>!  Users are
encouraged to use a revision control system (e.g. Git) and/or have
secure backups.

=head1 OPTIONS

=over

=item --debug, -d

Output debugging statements to STDERR.

=item --force, -f

By default a tidy only occurs when the input is valid and when the the
content changes reasonably (i.e. ignoring the REV and PRODID fields).
This flag forces a tidy to occur which can be used for the following:

=over

=item * Add missing N or FN fields, based on the card's UID. Handy for
fixing VCARDs exported from gmail that contain only email addresses.

=item * Overwrite the VERSION field

=item * Ensure the the REV field is updated.

=back

=item --help, -h

Print the full usage message and exit.

=item --no-rev, -R

Prevent B<vcardtidy> from updating the "REV" timestamp.

=item --nothing, -n

Do not write tidied output to files. In filter mode outputs the
original VCARD.

=item --regex, -r REGEX

Before tidying, evaluate a Perl C<s/old/new/> replacement expression
against the input.  Can be used multiple times. To add a NOTE and an
additional CATEGORY in one go for example:

    $ vcardtidy untidy.vcf \
       -r 's/^END:VCARD/NOTE:My note\r\nEND:VCARD/m'
       -r 's/^(CATEGORIES:.*)(\s+)$/\1,NewCategory\2/m'

Tools like sed(1), awk(1) and of course perl(1) are obviously natively
designed to modify text, in a better way. But C<--regex> ensures that
you still have a valid VCARD afterwards, allowing you to easily iterate
while you develop your change.

=item --vcard-version, -v VERSION

The value of VERSION to update (with C<--force>) or add (when none
exists). Defaults to "4.0".

=item --version, -V

Print the version and exit.

=back

=head1 SUPPORT

This tool is managed via github:

    https://github.com/mlawren/vcardtidy

=head1 SEE ALSO

L<Text::vCard::Addressbook>, L<githook-perltidy>(1)

=head1 AUTHOR

Mark Lawrence E<lt>mark@rekudos.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2022-2026 Mark Lawrence <mark@rekudos.net>

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.

