Changed structure of perl modules to be more useful.
[licom.git] / licom.cgi
index 4af14ad..5abb2e6 100755 (executable)
--- a/licom.cgi
+++ b/licom.cgi
@@ -9,10 +9,11 @@ use CGI::Carp (qw(fatalsToBrowser));
 use URI::Escape;
 use Data::Dumper;
 
-use Person;
+use LiCoM::Config (qw(get_config));
+use LiCoM::Person;
 
 our $Debug = 0;
-our %Config = ();
+our $Config = {};
 
 our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group));
 
@@ -46,21 +47,24 @@ our %Actions =
        vcard   => \&action_vcard
 );
 
-read_config ();
+$Config = get_config ();
 
 # make sure AuthLDAPRemoteUserIsDN is enabled.
 die unless ($ENV{'REMOTE_USER'});
-$Config{'base_dn'} = $ENV{'REMOTE_USER'};
+$Config->{'base_dn'} = $ENV{'REMOTE_USER'};
 
-Person->connect
+die unless (defined ($Config->{'uri'}) and defined ($Config->{'base_dn'})
+       and defined ($Config->{'bind_dn'}) and defined ($Config->{'password'}));
+
+LiCoM::Person->connect
 (
-       uri     => $Config{'uri'},
-       base_dn => $Config{'base_dn'},
-       bind_dn => $Config{'bind_dn'},
-       password => $Config{'password'}
+       uri     => $Config->{'uri'},
+       base_dn => $Config->{'base_dn'},
+       bind_dn => $Config->{'bind_dn'},
+       password => $Config->{'password'}
 ) or die;
 
-our ($UserCN, $UserID) = Person->get_user ($Config{'base_dn'});
+our ($UserCN, $UserID) = LiCoM::Person->get_user ($Config->{'base_dn'});
 
 if (!$UserID and $Action ne 'save')
 {
@@ -89,9 +93,7 @@ elsif (ref ($Actions{$Action}) eq 'ARRAY')
        }
 }
 
-#print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
-
-Person->disconnect ();
+LiCoM::Person->disconnect ();
 
 exit (0);
 
@@ -106,15 +108,16 @@ sub action_browse
        my @all;
        if ($group)
        {
-               @all = Person->search ([[group => $group]]);
+               @all = LiCoM::Person->search ([[group => $group]]);
        }
        else
        {
-               @all = Person->search ();
+               @all = LiCoM::Person->search ();
        }
 
        if (!$group)
        {
+               my @nogroup = ();
                my %groups = ();
                for (@all)
                {
@@ -122,7 +125,10 @@ sub action_browse
                        my @g = $person->get ('group');
 
                        $groups{$_} = (defined ($groups{$_}) ? $groups{$_} + 1 : 1) for (@g);
+
+                       push (@nogroup, $person) if (!@g);
                }
+               @all = @nogroup;
 
                print qq(\t\t<h2>Contact Groups</h2>\n\t\t<ul class="groups">\n);
                for (sort (keys (%groups)))
@@ -146,7 +152,7 @@ sub action_browse
        }
        else
        {
-               print qq(\t\t<h2>All Contacts</h2>\n);
+               print qq(\t\t<h2>Contacts without a group</h2>\n);
        }
 
        print qq(\t\t<ul class="results">\n);
@@ -158,6 +164,10 @@ sub action_browse
 
                print qq(\t\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
        }
+       if (!@all)
+       {
+               print "\t\t\t<li>There are no matching entries.</li>\n";
+       }
        print qq(\t\t</ul>\n\n);
 
        print qq(\t\t<div class="menu">\n);
@@ -186,11 +196,11 @@ sub action_list
        my @all = ();
        if ($group)
        {
-               @all = Person->search ([[group => $group]]);
+               @all = LiCoM::Person->search ([[group => $group]]);
        }
        else
        {
-               @all = Person->search ();
+               @all = LiCoM::Person->search ();
        }
 
        print <<EOF;
@@ -243,7 +253,7 @@ sub action_detail
        $cn = shift if (@_);
        die unless ($cn);
 
-       my $person = Person->load ($cn);
+       my $person = LiCoM::Person->load ($cn);
        if (!$person)
        {
                print qq(\t<div>Entry &quot;$cn&quot; could not be loaded from DB.</div>\n);
@@ -340,7 +350,7 @@ sub action_search
                push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
        }
 
-       my @matches = Person->search (@filter);
+       my @matches = LiCoM::Person->search (@filter);
 
        if (!@matches)
        {
@@ -357,7 +367,7 @@ sub action_search
        }
 
        print qq(\t<ul class="result">\n);
-       for (@matches)
+       for (sort { $a->name () cmp $b->name () } (@matches))
        {
                my $person = $_;
                my $cn = $person->name ();
@@ -392,7 +402,7 @@ sub action_edit
 
        if ($cn)
        {
-               $person = Person->load ($cn);
+               $person = LiCoM::Person->load ($cn);
 
                if (!$person)
                {
@@ -543,7 +553,7 @@ sub action_save
 
        my $contacts = get_contacts ();
 
-       my $person = Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
+       my $person = LiCoM::Person->create (lastname => $lastname, firstname => $firstname, %$contacts);
 
        if (!$person)
        {
@@ -566,7 +576,7 @@ sub action_save
 sub action_update
 {
        my $cn = $UserID ? param ('cn') : $UserCN;
-       my $person = Person->load ($cn);
+       my $person = LiCoM::Person->load ($cn);
 
        die unless ($person);
 
@@ -623,7 +633,7 @@ sub action_vcard
        $cn = shift if (@_);
        die unless ($cn);
 
-       my $person = Person->load ($cn);
+       my $person = LiCoM::Person->load ($cn);
        die unless ($person);
 
        my %vcard_types =
@@ -672,7 +682,7 @@ sub action_verify
        $cn = shift if (@_);
        die unless ($cn);
 
-       my $person = Person->load ($cn);
+       my $person = LiCoM::Person->load ($cn);
        die unless ($person);
 
        my ($mail) = $person->get ('mail');
@@ -709,7 +719,7 @@ sub action_verify
 sub action_verify_send_mail
 {
        my $person = shift;
-       my $owner = Person->load ($UserCN);
+       my $owner = LiCoM::Person->load ($UserCN);
        my $smh;
 
        my ($owner_mail) = $owner->get ('mail');
@@ -1025,34 +1035,6 @@ sub html_end
 EOF
 }
 
-sub read_config
-{
-       my $file = '/var/www/html/cgi.verplant.org/address/book.conf';
-       my $fh;
-
-       open ($fh, "< $file") or die ("open ($file): $!");
-       for (<$fh>)
-       {
-               chomp;
-               my $line = $_;
-
-               if ($line =~ m/^(\w+):\s*"(.+)"\s*$/)
-               {
-                       my $key = lc ($1);
-                       my $val = $2;
-
-                       $Config{$key} = $val;
-               }
-       }
-
-       close ($fh);
-
-       for (qw(uri bind_dn password))
-       {
-               die ("Not defined: $_") unless (defined ($Config{$_}));
-       }
-}
-
 sub pwgen
 {
        my $len = @_ ? shift : 6;