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

our $VERSION = 'v1.0.5';

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)',
        },
        nothing => {
            isa     => '--Flag',
            alias   => 'n',
            comment => q{don't modify files, only report errors},
        },
        force => {
            isa     => '--Flag',
            alias   => 'f',
            comment => 'insert missing fields where required',
        },
        filter => {
            isa      => '--ArrayRef',
            isa_name => 'PERL',
            alias    => 'F',
            comment  => 'Perl filter(s) to run against $_ first',
            default  => sub { [] },
        },
        no_rev => {
            isa     => '--Flag',
            alias   => 'R',
            comment => 'do not update REV value'
        },
        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 = App::vcardtidy::run_filters( $data, @{ $opts->{filter} } );

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

package App::vcardtidy;

sub run_filters {
    local $_ = shift;
    foreach my $filter (@_) {
        eval $filter;
        die qq{filter "$filter" failed:\n$@} if $@;
    }
    $_;
}

__END__

=head1 NAME

vcardtidy - normalize the format of VCARD files

=head1 VERSION

v1.0.5 (2026-01-15)

=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>.

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

=head1 OPTIONS

=over

=item --filter, -F PERL

Before tidying, evaluate the C<PERL> string with C<$_> set to the input
text. The modified C<$_> value then input to
L<Text::vCard::Addressbook> for tidying.

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

To add an additional or missing category for example:

    $ vcardtidy \
       -f '$_ .= "\nCATEGORIES:\n" unless m/^CATEGORIES:/m' \
       -f 's/^(CATEGORIES:\S+)(\s+)$/$1,$2/m' \
       -f 's/^(CATEGORIES:.*)(\s+)$/${1}NewCat$2/m'

If the result cannot be parsed by L<Text::vCard> then no files are
modified or output generated.

=item --force, -f

Force a tidy to occur by adding missing N and FN fields based on the
UID.

This can also be used to overwrite the VERSION field.

=item --help, -h

Print the full usage message and exit.

=item --no-rev, -R

By default B<vcardtidy> sets a new "REV" timestamp. Use this flag to
prevent that.

=item --nothing, -n

Do not write

=item --vcard-version, -v VERSION

The desired vCard VERSION 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.

