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/.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 );
</perl>
+
</source>
 +
[[Category:PERL]]

Latest revision as of 02:55, 23 April 2020

Legacy.svg Legacy: This article describes a concept that has been superseded in the course of ongoing development on the Organic Design wiki. Please do not develop this any further or base work on this concept, this is only useful for a historic record of work done. You may find a link to the currently used concept or function in this article, if not you can contact the author to find out what has taken the place of this legacy item.
#!/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 );