Difference between revisions of "PERL-Copy-Contacts"
From Organic Design wiki
m |
m |
||
(One intermediate revision by the same user not shown) | |||
Line 1: | Line 1: | ||
− | <perl> | + | {{legacy}} |
+ | <source lang="perl"> | ||
#!/usr/bin/perl | #!/usr/bin/perl | ||
# Scan contacts in CWD, and copy email of contact to clipboard | # Scan contacts in CWD, and copy email of contact to clipboard | ||
Line 23: | Line 24: | ||
opendir(DIR, cwd) || die "can't open CWD!"; | opendir(DIR, cwd) || die "can't open CWD!"; | ||
for (grep /^C-.+$/i, readdir DIR) { | for (grep /^C-.+$/i, readdir DIR) { | ||
− | + | s/.lnk$//i; | |
s/^c-//i; | s/^c-//i; | ||
my $contact = $_; | my $contact = $_; | ||
Line 47: | Line 48: | ||
# Copy to clipboard as separated list | # Copy to clipboard as separated list | ||
$clip->Set( join $separator, @emails ); | $clip->Set( join $separator, @emails ); | ||
− | </ | + | </source> |
+ | [[Category:PERL]] |
Latest revision as of 02:55, 23 April 2020
#!/usr/bin/perl
# Scan contacts in CWD, and copy email of contact to clipboard
# Separator character can be sent in command-line ("," is default)
# nad - 2005-04-29
# Requirements
use Win32;
use Win32::Clipboard;
use Cwd;
# Set up local environment
$clip = Win32::Clipboard();
$cwd = cwd;
$separator = $#ARGV == 0 ? pop(@ARGV) : ",";
@emails = ();
@bad_links = ();
@no_emails = ();
# Retrieve contacts' email addresses
if ($cwd =~ /(.+my organisation\/)/i) {
my $contacts = "$1C - Contacts/";
opendir(DIR, cwd) || die "can't open CWD!";
for (grep /^C-.+$/i, readdir DIR) {
s/.lnk$//i;
s/^c-//i;
my $contact = $_;
my $opened = 1;
opendir(CONTACT, $contacts."C-$contact") or $opened = 0;
if ($opened == 1) {
my @list = map {/(.+)\.url$/; "\"$contact\"<$1>";} grep /[@]+/, readdir CONTACT;
$#list+1 ? push @emails, @list : push @no_emails, $contact;
closedir CONTACT;
} else {push @bad_links, $contact}
}
closedir DIR;
}
# Report non-existent contacts
Win32::MsgBox(join("\n", @bad_links), MB_ICONEXCLAMATION, "Could not find the following contacts!")
if $#bad_links+1;
# Report contacts without emails addresses
Win32::MsgBox(join("\n", @no_emails), MB_ICONINFORMATION, "The following contacts have no email address...")
if $#no_emails+1;
# Copy to clipboard as separated list
$clip->Set( join $separator, @emails );