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

our $VERSION = 'v1.1.0';

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',
        },
        regex => {
            isa      => '--ArrayRef',
            isa_name => 'REGEX',
            alias    => 'r',
            comment  => 'Regular expression to run against $_ first',
            default  => sub { [] },
        },
        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},
        },
        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 $dtstamp = localtime->strftime('%Y-%m-%dT%H%M%SZ');

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 $file;

    if ( $opts->{input} eq '-' ) {
        local $/;
        binmode STDIN, ':raw:encoding(UTF-8)';
        $data = <STDIN>;
    }
    else {
        $file = path( $opts->{input} );
        $data = $file->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 {
            use feature 'state';
            state @c     = ( 'a' .. 'f', 0 .. 9 );
            state $len_c = scalar @c;
            my $uid = join '-', map {
                join '',
                  map { $c[ rand($len_c) ] }
                  @$_
            } [ 1 .. 8 ], [ 1 .. 4 ], [ 1 .. 4 ], [ 1 .. 4 ], [ 1 .. 12 ];

            $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;
            }
        }

        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};
        $vcard->PRODID("vcardtidy $VERSION");

        $i++;
    }

    # 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 ) { }

    if ( $opts->{debug} ) {
        print STDERR "vcardtidy:\n";
        _diff( $data, $tidy );
    }

    if ( $opts->{input} eq '-' ) {
        binmode STDOUT, ':raw:encoding(UTF-8)';
        print $tidy;
    }
    else {
        my $data2 = $data;
        $data2 =~ s/^REV:.*\015\012//m;
        $data2 =~ s/^PRODID:.*\015\012//m;

        my $tidy2 = $tidy;
        $tidy2 =~ s/^REV:.*\015\012//m;
        $tidy2 =~ s/^PRODID:.*\015\012//m;

        $file->spew( { binmode => ':raw:encoding(UTF-8)' }, $tidy )
          unless $opts->{nothing}
          or ( $data2 eq $tidy2 and not $opts->{force} );
    }

    1;
}

sub _diff {
    my ( $t1, $t2 ) = @_;
    require Text::Diff;
    print STDERR ( Text::Diff::diff( \$t1, \$t2 ) || "(No change)\n" ) =~
      s/^/    /gmr;
}

__END__

=head1 NAME

vcardtidy - normalize the format of VCARD files

=head1 VERSION

v1.1.0 (2026-01-20)

=head1 SYNOPSIS

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

=head1 DESCRIPTION

B<vcardtidy> formats VCARD files, using L<Text::vCard::Addressbook> to
normalize field order and capitalization.

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 --regex, -r REGEX

Before tidying, evaluate C<REGEX> 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 --force, -f

Force a tidy to occur when the N or FN fields are missing, by creating
them based on the card's UID.

This flag can also be used to overwrite the VERSION field or ensure the
the REV field is updated.

=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 --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>nomad@null.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2022-2026 Mark Lawrence <nomad@null.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.

