diff options
Diffstat (limited to 'local/.bin/update-addressbook')
-rwxr-xr-x | local/.bin/update-addressbook | 276 |
1 files changed, 0 insertions, 276 deletions
diff --git a/local/.bin/update-addressbook b/local/.bin/update-addressbook deleted file mode 100755 index 4683e86..0000000 --- a/local/.bin/update-addressbook +++ /dev/null @@ -1,276 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use 5.020; -use feature 'signatures'; -no warnings 'experimental::signatures'; - -use Config::INI::Reader; -use Config::INI::Writer; -use Email::Address; -use File::Find; - -my @exclude_patterns = ( - # quoted-printable (needs special handling, punting for now) - sub($address) { $address->format =~ /^=\?/ }, - # automated emails - sub($address) { $address->address =~ /(mailer-daemon|noreply)/i }, -); - -# abook uses # for comments instead of ; -package Abook::Reader { - use base 'Config::INI::Reader'; - - sub preprocess_line($self, $line) { - ${$line} =~ s/\s+#.*$//g; - } - - sub can_ignore($self, $line, $) { - return $line =~ /\A\s*(?:#|$)/ ? 1 : 0; - } -} - -# abook is super finicky about its input format -package Abook::Writer { - use base 'Config::INI::Writer'; - - sub write_handle($self, $input, $handle) { - print $handle "# abook addressbook file\n\n"; - $self->SUPER::write_handle($input, $handle); - } - - sub preprocess_input($self, $data) { - my $ini_data = [ - format => { - program => 'abook', - version => '0.6.1', - }, - ]; - my $i = 0; - for my $name (sort { fc($a) cmp fc($b) } keys %$data) { - my $person_data = $data->{$name}->as_hashref; - delete $person_data->{name}; - push @$ini_data, ( - $i++ => [ - name => $name, - %$person_data, - ], - ); - } - - $self->SUPER::preprocess_input($ini_data); - } - - sub stringify_value_assignment($self, $name, $value) { - return '' unless defined $value; - return $name . '=' . $self->stringify_value($value) . "\n"; - } -} - -package Person { - sub from_hashref($class, $data) { - return bless $data, $class; - } - - sub from_email($class, $name, $addresses) { - return $class->from_hashref({ - name => $name, - email => join(',', map { $_->address } @$addresses), - }); - } - - sub addresses($self) { - return split(',', $self->{email} // ''); - } - - sub as_hashref($self) { - return { %$self }; - } -} - -sub existing_people($addressbook) { - my $data = Abook::Reader->read_file($addressbook); - delete $data->{format}; - - my %people; - for my $id (keys %$data) { - my $person = $data->{$id}; - $people{$person->{name}} = Person->from_hashref($person); - } - - return %people; -} - -sub maildir_addresses($maildir) { - my %addresses; - - find(sub() { - open my $fh, '<', $_ or die "couldn't open $_: $!"; - while (<$fh>) { - last if /^$/; - next unless /^(?:From|Sender): /; - for my $address (Email::Address->parse($_)) { - $address = Email::Address->new( - $address->name, - $address->address, - ); - - my $name = $address->name; - my $format = $address->format; - - next if $addresses{$name} && - grep { $format eq $_ } @{ $addresses{$name} }; - next if grep { $_->($address) } @exclude_patterns; - - push @{ $addresses{$name} ||= [] }, $address; - } - } - close $fh; - }, $maildir); - - return %addresses; -} - -sub merge_addresses($old, $new) { - my %reverse_old = map { - map { $_->address => $_->name } @$_ - } values %$old; - my @new_addresses = map { - map { $_->address } @$_ - } values %$new; - - my %seen_address; - my %reverse_ret; - for my $new_address (@new_addresses) { - next if $seen_address{$new_address}++; - - my @related_addresses = ($new_address); - my @related_names; - while (1) { - my @new_related_names = map { - my $cur_address = $_; - ( - (grep { - grep { - fc($_->address) eq fc($cur_address) - } @{ $new->{$_} } - } keys %$new), - (grep { - grep { - fc($_->address) eq fc($cur_address) - } @{ $old->{$_} } - } keys %$old), - ) - } @related_addresses; - @new_related_names = keys( - %{ { map { $_ => 1 } @new_related_names } } - ); - - my @new_related_addresses = map { - $_->address - } map { - ( - (exists $new->{$_} - ? (@{ $new->{$_} }) - : ()), - (exists $old->{$_} - ? (@{ $old->{$_} }) - : ()), - ) - } @new_related_names; - @new_related_addresses = keys( - %{ { map { $_ => 1 } @new_related_addresses } } - ); - - last if @related_names == @new_related_names - && @related_addresses == @new_related_addresses; - - @related_addresses = @new_related_addresses; - @related_names = @new_related_names; - } - - my ($name) = grep { exists $old->{$_} } @related_names; - $name = (sort @related_names)[0] unless defined $name; - - for my $related_address (@related_addresses) { - $seen_address{$related_address}++; - $reverse_ret{$related_address} = $name; - } - } - - %reverse_ret = (%reverse_old, %reverse_ret); - - my %ret; - for my $address (keys %reverse_ret) { - my $name = $reverse_ret{$address}; - push @{ $ret{$name} ||= [] }, Email::Address->new($name, $address); - } - - for my $name (keys %ret) { - my %seen_name; - for my $address (@{ $ret{$name} }) { - if (defined $seen_name{lc($address->address)}) { - if (defined $reverse_old{$address->address}) { - $seen_name{lc($address->address)} = $address; - } - } - else { - $seen_name{lc($address->address)} = $address; - } - } - $ret{$name} = [ values %seen_name ]; - } - - return %ret; -} - -sub merge_people($old, $new) { - for my $name (keys %$new) { - if (exists $old->{$name}) { - my $old_person = $old->{$name}; - my @addresses = $old_person->addresses; - for my $address ($new->{$name}->addresses) { - push @addresses, $address - unless grep { $_ eq $address } @addresses; - } - - $old_person->{email} = join(',', @addresses); - } - else { - $old->{$name} = $new->{$name}; - } - } - - return %$old; -} - -sub main($addressbook, $maildir) { - die "usage: $0 ADDRESSBOOK MAILDIR" unless @_ == 2; - - my %existing_people = existing_people($addressbook); - my %existing_addresses = map { - my $name = $_; - $name => [ - map { - Email::Address->new($name, $_) - } $existing_people{$name}->addresses - ] - } keys %existing_people; - - my %maildir = maildir_addresses($maildir); - - my %new_addresses = merge_addresses(\%existing_addresses, \%maildir); - my %new_people = map { - $_ => Person->from_email($_, $new_addresses{$_}) - } keys %new_addresses; - - my %new_abook = merge_people(\%existing_people, \%new_people); - - rename $addressbook => "$addressbook.bak" - or die "couldn't rename $addressbook: $!"; - - my $writer = Abook::Writer->new; - $writer->write_file(\%new_abook, $addressbook); -} - -main(@ARGV); |