Many bugs fixed, more features inplemented. Rapid debelopment at work..

diff --git a/book.cgi b/book.cgi
index c6de51e..8a616b1 100755 (executable)
--- a/book.cgi
+++ b/book.cgi
@@ -16,6 +16,18 @@ our %Config = ();
 
 our @MultiFields = (qw(address homephone cellphone officephone fax mail uri group));
 
+our %FieldNames = 
+(
+       address         => 'Address',
+       homephone       => 'Home Phone',
+       cellphone       => 'Cellphone',
+       officephone     => 'Office Phone',
+       fax             => 'FAX',
+       mail            => 'E-Mail',
+       uri             => 'URI (Homepage)',
+       group           => 'Group'
+);
+
 our $MySelf = $ENV{'SCRIPT_NAME'};
 
 our $Action = param ('action');
@@ -24,6 +36,7 @@ $Action ||= 'default';
 our %Actions =
 (
        default => \&action_default,
+       detail  => \&action_detail,
        edit    => \&action_edit,
        save    => \&action_save,
        search  => \&action_search
@@ -69,7 +82,7 @@ if (!defined ($Actions{$Action}))
 
 $Actions{$Action}->();
 
-print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
+#print qq#<div>Authenticated as ($UserCN, $UserID, #, $Config{'base_dn'}, qq#)</div>\n#;
 
 print_html_end ();
 
@@ -84,9 +97,103 @@ sub action_default
        print "<code>action_default</code>\n";
 }
 
+sub action_detail
+{
+       my $cn = param ('cn');
+       die unless ($cn);
+
+       my $person = Person->load ($cn);
+       if (!$person)
+       {
+               print qq(\t<div>Entry &quot;$cn&quot; could not be loaded from DB.</div>\n);
+               return;
+       }
+
+       my $cn_esc = uri_escape ($cn);
+
+       print <<EOF;
+       <table class="detail">
+               <tr>
+                       <th>Name</th>
+                       <td>$cn</td>
+               </tr>
+EOF
+       for (@MultiFields)
+       {
+               my $field = $_;
+               my $values = $person->get ($field);
+               my $num = scalar (@$values);
+               my $print = defined ($FieldNames{$field}) ? $FieldNames{$field} : $field;
+
+               next unless ($num);
+
+               print "\t\t<tr>\n";
+               if ($num > 1)
+               {
+                       print qq(\t\t\t<th rowspan="$num">$print</th>\n);
+               }
+               else
+               {
+                       print qq(\t\t\t<th>$print</th>\n);
+               }
+
+               for (my $i = 0; $i < $num; $i++)
+               {
+                       my $val = $values->[$i];
+                       print "\t\t<tr>\n" if ($i);
+                       print "\t\t\t<td>$val</td>\n",
+                       "\t\t</tr>\n";
+               }
+       }
+       print <<EOF;
+       </table>
+       <div class="detail menu">
+               [<a href="$MySelf?action=edit&cn=$cn_esc">edit</a>]
+       </div>
+EOF
+}
+
 sub action_search
 {
-       print "<code>action_search</code>\n";
+       my $search = param ('search');
+
+       $search ||= '';
+       $search =~ s/[^\s\w]//g;
+
+       if (!$search)
+       {
+               print qq(\t<div class="error">Sorry, the empty search is not allowed.</div>\n);
+               action_default ();
+               return;
+       }
+
+       my @patterns = split (m/\s+/, $search);
+       my @filter = ();
+
+       for (@patterns)
+       {
+               my $pattern = "$_*";
+               push (@filter, [[lastname => $pattern], [firstname => $pattern]]);
+       }
+
+       my @matches = Person->search (@filter);
+
+       if (!@matches)
+       {
+               print qq(\t<div>No entries matched your search.</div>\n);
+               return;
+       }
+
+       print qq(\t<ul class="result">\n);
+       for (@matches)
+       {
+               my $person = $_;
+               my $cn = $person->name ();
+               my $cn_esc = uri_escape ($cn);
+
+               print qq(\t\t<li><a href="$MySelf?action=detail&cn=$cn_esc">$cn</a></li>\n);
+       }
+       print qq(\t</ul>\n);
 }
 
 sub action_edit
@@ -354,6 +461,12 @@ div.foot
 {
        color: gray;
        background-color: white;
+
+       position: absolute;
+       top: auto;
+       right: 0px;
+       bottom: 0px;
+       left: 0px;
        
        font-size: x-small;
        text-align: right;
@@ -382,7 +495,9 @@ th
 {
        color: black;
        background-color: #999999;
+       padding: 0.3ex;
        text-align: left;
+       vertical-align: top;
 }
 //-->
 </style>
@@ -409,13 +524,13 @@ EOF
        <hr />
 EOF
        }
-       print "\t<h1>octo's lightweight address book</h1>\n";
+       print "\t<h1>octo's Lightweight Address Book</h1>\n";
 }
 
 sub print_html_end
 {
        print <<EOF;
-               <div class="foot">octo's Address Book &lt;octo at verplant.org&gt;</div>
+               <div class="foot">octo's Lightweight Address Book &lt;octo at verplant.org&gt;</div>
        </body>
 </html>
 EOF

diff --git a/lib/Person.pm b/lib/Person.pm
index 79ed9f7..96a5977 100644 (file)
--- a/lib/Person.pm
+++ b/lib/Person.pm
@@ -134,7 +134,7 @@ sub load
        my $pkg = shift;
        my $cn = shift;
 
-       my ($retval) = search ($pkg, cn => $cn);
+       my ($retval) = search ($pkg, [[cn => $cn]]);
 
        if (!$retval)
        {
@@ -245,47 +245,67 @@ sub create
 
 Search for the given patterns. Returns a list of I<Person>-objects.
 
+  @filter =
+  (
+    [
+      [field => value], # OR
+      [field => value]
+    ], # AND
+    ...
+  );
+
 =cut
 
 sub search
 {
        my $pkg = shift;
-       my %patterns = @_;
-       my %filter = ();
-       my $filter = '(objectclass=inetOrgPerson)';
+
+       my @patterns = @_;
+       my @konjunct = ();
+       my $filter;
+
        my $mesg;
        my @retval = ();
 
-       for (keys %patterns)
+       for (@patterns)
        {
-               my $key = $_;
-               my $val = $patterns{$key};
+               my $dj = $_;
+               my @disjunc = ();
 
-               $key = $ExternalNames{$key} if (defined ($ExternalNames{$key}));
-               if (!defined ($ValidFields{$key}))
+               for (@$dj)
                {
-                       warn ("Not a valid field: $key");
-                       next;
-               }
+                       my $field = $_->[0];
+                       my $value = $_->[1];
 
-               $filter{$key} = $val;
-       }
+                       $field = $ExternalNames{$field} if (defined ($ExternalNames{$field}));
+                       if (!defined ($ValidFields{$field}))
+                       {
+                               warn ("Not a valid field: $field");
+                               next;
+                       }
 
-       if (%filter)
-       {
-               if (scalar (keys %filter) == 1)
-               {
-                       my ($key) = keys (%filter);
-                       my $val = $filter{$key};
-                       $filter = "(& $filter ($key=$val))";
+                       $value =~ s/([\(\)\\])/\\$1/g;
+
+                       push (@disjunc, "($field=$value)");
                }
-               else
+                       
+               if (@disjunc)
                {
-                       my $tmp = join (' ', map { '(' . $_ . '=' . $filter->{$_} . ')' } (keys (%$filter)));
-                       $filter = "(& $filter (| $tmp))";
+                       push (@konjunct, join ('', '(|', @disjunc, ')'));
                }
        }
 
+       if (@konjunct)
+       {
+               $filter = join ('', '(&(objectclass=inetOrgPerson)', @konjunct, ')');
+       }
+       else
+       {
+               $filter = '(objectclass=inetOrgPerson)';
+       }
+
+       print STDERR "Debug: using filter: $filter";
+       
        $mesg = $Ldap->search
        (
                base   => $Config{'base_dn'},