contacts.pl

使用perl和C写的基于Web的管理数据库表的程序

#!/usr/bin/perl
# -----------------------------------------------------------------------------
# TWC
# Treuwert-Computer GmbH
# Schlo遙ergring 9
# 79098 Freiburg
#
# -----------------------------------------------------------------------------
# Programm-Daten
# -----------------------------------------------------------------------------
# Projekt  :
# System   :
# Programm :
# Modul    : $RCSfile: Contacts.pl,v $
# Version  : $Revision: 1.1 $
# Stand von: $Date: 1999/12/02 16:19:20 $
# Status   : $State: Exp $
#
# Kurzbeschreibung:
# Dieses Modul enth鋖t die ben鰐igten-Routinen zur Pflege der
# Kontakt-Datenbank
# -----------------------------------------------------------------------------
# Aenderungen:
# $Log: Contacts.pl,v $
# Revision 1.1  1999/12/02 16:19:20  klaus
# new file-struct
#
# Revision 1.1  1999/11/23 15:39:13  klaus
# New lib-directory
#
# Revision 1.9  1999/11/22 10:33:27  klaus
# - Last corrections before 0.0.4
#
# Revision 1.8  1999/11/15 13:52:37  klaus
# - HTML-output buffered
# - WWWdb_(Pre|Post).(rc|pl)
# - own tmp-directory
# - little customizations  for qry-mode
# - enhancement of debug-trace-utilities
# - API: GetAttr()
#
# Revision 1.7  1999/11/11 13:22:49  klaus
# Snapshot for internal installation
#
# Revision 1.6  1999/11/02 12:01:59  klaus
# Check-in to store actual state
#
# Revision 1.5  1999/10/21 13:35:05  klaus
# - Select and Radio-Fields can now be filled with SQL
# - WWWdb is now "-w"-proof
# - Database-Errors are now shown uniquely
#
# Revision 1.4  1999/10/20 13:01:34  klaus
# Version 1.0.3
# - Getting field-type-information
# - Plugins to convert DB-data to Form-data and vice versa
# - New API-functions
#    $current_state = GetState();
#    $cust_type = GetFieldTypeName($field_name);
#
# BUGFIX:
# -kfm, lynx and w3m seem to work now
#
# Revision 1.3  1999/10/08 13:48:10  klaus
# - Selection-Boxes and radio-fields now can have labels
# - plugins: API-Documentation
# - Perl-makefile integrated
#
# Revision 1.2  1999/10/06 08:42:13  klaus
# Checkpoint before copying to WWW-server
#
# Revision 1.1  1999/10/06 06:31:45  klaus
# Creation
#
# Revision 1.1.1.1  1999/09/27 08:50:27  klaus
# Integration in CVS
#
# Revision 1.1.1.1  1999/09/27 08:09:51  klaus
# Imported using tkCVS
#
#
# --- FIX ----- FIX ----- FIX ----- FIX ----- FIX ----- FIX -------------------
# NOCH ZU ERLEDIGEN:      (-) offen           (+) teils erledigt
# - FIX-MEs in der Source bereinigen
#
# ----------------------------------------------------------------------------
# --- FIX ----- FIX ----- FIX -----FIX ----- FIX ----- FIX -------------------

sub PreCreateForm ()
{
   if(!&SessionIdGetState("ActualLogin"))
   {

      if("Button_deactivated")
      {
         &MySetVal("State Init", "BtnNew", "-");
         &MySetVal("State Work", "BtnUpd", "-");
         &MySetVal("State Work", "BtnDel", "-");
      }
      else
      {
         &OkForm("ERROR",
                 sprintf(i18n("Sorry, please %s first!"),
                         "<A HREF=" .
                         &CreateReference(&GetAttr("SessionId"),
                                          "Login") .
                         ">" .
                         i18n("login") .
                      "</A>"),
                 "BtnExit");
         &MyExit();
      }
   }
}

# --- Feld company pr黤en --------------------------------------------------
sub Check_contacts_company()
{
   &AddError("company", "No company (or last name), please enter!!")
       if(!&GetField("company") && !&GetField("last_name"));
}


# --- Feld conttyp1 pr黤en -----------------------------------------------
sub Check_contacts_conttyp1()
{
   &AddError("conttyp1", "No contact-type (1), please select!!")
       if(!&GetField("conttyp1"));
}


# --- Feld conttyp1 pr黤en -----------------------------------------------
sub Check_contacts_contadr1()
{
   &AddError("contadr1", "No contact-adress (1), please select!!")
       if(!&GetField("contadr1"));
}

# --- Feld sex pr黤en -----------------------------------------------
sub Check_contacts_sex()
{
   &AddError("sex",
             "No sex selected, altough the first name is known. " .
             "Please select!!")
       if(!&GetField("sex") and &GetField("first_name"));
}




# --- Gesamtpr黤ung f黵 Datenintegrit鋞 ---------------------------------
sub Check_contacts_EveryField($)
{
   my $cFieldNamePI = shift;

}



# --- Feld conttyp1 pr黤en -----------------------------------------------
sub Check_contacts()
{
   my $iInd;

   for $iInd (1..5) {
      if((&GetField("contadr$iInd")) and
         (!&GetField("conttyp$iInd")))
      {
         &AddError("conttyp$iInd",
                   "For contact-address ($iInd), the contact-type is missing!!");
      }

      if((!&GetField("contadr$iInd")) and
         (&GetField("conttyp$iInd")))
      {
         &AddError("contadr$iInd",
                   "For contact-type ($iInd), the contact-address is missing!!");
      }

      &NormConttyp($iInd)
          if(&GetField("contadr$iInd"))
   }

   # Set time-stamp
   &SetField("last_change", scalar(localtime()));
}



sub PreBtnQry ()
{
   &SetField("title",
             &GetField("title") .
             &GetField("title1"));

   &SetField("state", "!= DEL");

}


sub PreBtnNew ()
{
   if (&GetField("title1"))
   {
      &SetField("title", &GetField("title1"));
   }

   &SetField("state", "");

}


sub PreBtnUpd ()
{
   if (&GetField("title1"))
   {
      &SetField("title", &GetField("title1"));
   }

}



sub MyBtnDel ()
{
    &SetField("state", "DEL");

    &BtnUpd();
}


# --- Dieses Modul normiert Telefonnummern, um ein einheitliches
#     Aussehen zu gew鋒rleisten
sub NormConttyp ($)
{
   my $iIndPI = shift;

   my $cKommAdr = &GetField("contadr$iIndPI");
   my $cKommTyp = &GetField("conttyp$iIndPI");

   # Nur Adressen bearbeiten, die nur f黵 Telefonnummern relevante
   # Zeichen beinhalten
   unless ($cKommAdr =~ /.*[^\/+.()0-9 -].*/)
   {

      # + durch int.Vorwahl ersetzen
      if($cKommAdr =~ /^\+\d\d ?/) {
         $cKommAdr =~ s/^\+(\d\d) ?/00$1 /;
      }

      # Sonderzeichen normieren
      $cKommAdr =~ s%[-/.()]% %g;

      # Leerzeichen trimmen (mehrfache, am Anfang, am Ende)
      $cKommAdr =~ s/\s+/ /g;
      $cKommAdr =~ s/^\s+//;
      $cKommAdr =~ s/\s+$//;

      # internationale Nummern
      if($cKommAdr =~ /^00\d\d ?/) {
         $cKommAdr =~ s/^00(\d\d) ?/+$1 /;
      }
      # nationale Nummern
      elsif($cKommAdr =~ /^0.*/) {

         # Handies herausfiltern
         if($cKommAdr =~ /^01[67][123].*/) {
            $cKommTyp = "Handy";
         }

         $cKommAdr =~ s/^0/+49 /;
      }
      else {
         # lokale Nummern
         $cKommAdr = "+49 761 " . $cKommAdr;
      }

      # Vorwahl in Klammern setzen
      $cKommAdr =~ s/^(\+\d+ )(\d+)(.*)/$1($2)$3/;

      # Duchwahl mit - abtrennen
      $cKommAdr =~ s/(\d) (\d+)$/$1-$2/;

      if(length($cKommAdr) >= 40) {
         $cKommAdr = substr($cKommAdr, 0, 40);
      }

   } # unless ($cKommAdr =~ /[!/+.()0-9 -]/)

   &SetField("contadr$iIndPI", $cKommAdr);
   &SetField("conttyp$iIndPI", $cKommTyp);
}

1;