[prev in list] [next in list] [prev in thread] [next in thread] 

List:       openpkg-cvs
Subject:    [CVS] OpenPKG: openpkg-registry/ registry-ui.pl
From:       "Thomas Lotterer" <thl () openpkg ! org>
Date:       2006-06-30 14:55:01
Message-ID: 20060630145501.F38F11B506E () master ! openpkg ! org
[Download RAW message or body]

  OpenPKG CVS Repository
  http://cvs.openpkg.org/
  ____________________________________________________________________________

  Server: cvs.openpkg.org                  Name:   Thomas Lotterer
  Root:   /v/openpkg/cvs                   Email:  thl@openpkg.org
  Module: openpkg-registry                 Date:   30-Jun-2006 16:55:01
  Branch: HEAD                             Handle: 2006063015550000

  Modified files:
    openpkg-registry        registry-ui.pl

  Log:
    work off to leverage String::Divert

  Summary:
    Revision    Changes     Path
    1.62        +253 -221   openpkg-registry/registry-ui.pl
  ____________________________________________________________________________

  patch -p0 <<'@@ .'
  Index: openpkg-registry/registry-ui.pl
  ============================================================================
  $ cvs diff -u -r1.61 -r1.62 registry-ui.pl
  --- openpkg-registry/registry-ui.pl	30 Jun 2006 12:15:29 -0000	1.61
  +++ openpkg-registry/registry-ui.pl	30 Jun 2006 14:55:00 -0000	1.62
  @@ -35,6 +35,7 @@
   use DBD::Pg;
   use MIME::Base64;
   use XML::Simple;
  +use String::Divert;
   
   #   configure optional debugging
   $Data::Dumper::Purity = 1;
  @@ -43,13 +44,19 @@
   
   #   program name, version and date
   my $progname="registry-ui.pl";
  -my $progvers="0.4.1";
  -my $progdate="12-May-2006";
  +my $progvers="0.5.0";
  +my $progdate="20060224234220";
   
   #   determine path to OpenPKG instance
   my $PREFIX='@l_prefix@';
   $PREFIX=$ENV{OPENPKG_PREFIX} if ($ENV{OPENPKG_PREFIX} ne "");
   
  +#   initialize output
  +my $response = {};
  +$response->{header} = {};
  +$response->{message} = new String::Divert;
  +$response->{message}->fold("message");
  +
   #   configuration
   #
   my $cfg = {};
  @@ -74,8 +81,8 @@
   $cfg->{canvas}->{mark_body}="<!-- CANVAS: BODY -->";
   $cfg->{page}->{default} = undef;
   $cfg->{status}->{showuser} = 1;
  -$cfg->{status}->{showversion} = 1;
  -$cfg->{status}->{showsid} = 1;
  +$cfg->{status}->{showversion} = 0;
  +$cfg->{status}->{showsid} = 0;
   
   my $ase;
   $ase = undef;
  @@ -85,12 +92,11 @@
   }
   
   #   create objects
  -my $cgi  = new CGI;
  +my $cgi = new CGI;
   my $myurl = $cgi->url(-relative => 1) || ".";
   my $sid = $cgi->cookie("registry-sid") || undef;
  -my $requestedpage = $cgi->url_param("page") || $cfg->{page}->{default};
  -$cgi->delete(-name=>'page');
  -my $out = undef;
  +my $requestedpage = $cgi->url_param("page") || $cfg->{page}->{default}; \
$cgi->delete(-name=>'page');  +my $session; $session = undef;
   
   #   database handle and scratch variables
   #
  @@ -102,7 +108,7 @@
   my $dbh; # database handle
   my $dbs; # database handle for session
   
  -sub dbopen($) {
  +sub dbopen ($) {
       my ($db) = @_;
       my $dbi;
       $dbi = undef;
  @@ -138,49 +144,51 @@
   #   first check for pages which do not require database access
   #
   if    ($requestedpage eq "css") {
  -    $out = '';
  -    $out .= &viewhttp('text/css', '+3600s');
  -    $out .= &viewcss();
  -    print STDOUT $out;
  +    &viewcss();
  +    goto CUS;
   }
   elsif ($requestedpage eq "jpg") {
  -    $out = '';
  -    $out .= &viewhttp('image/jpg', '+3600s');
  -    $out .= &viewjpg($cgi->param("name"));
  -    print STDOUT $out;
  +    &viewjpg($cgi->param("name"));
  +    goto CUS;
   }
   elsif ($requestedpage eq "gif") {
  -    $out = '';
  -    $out .= &viewhttp('image/gif', '+3600s');
  -    $out .= &viewgif($cgi->param("name"));
  -    print STDOUT $out;
  +    &viewgif($cgi->param("name"));
  +    goto CUS;
   }
  +else { #FIXME defer indentation making diff better readable
   
   #   pages below require database access
   #
   $dbh = &dbopen("registry");
   if (not defined $dbh) {
  -    &printprettyerror("Registry database backend unavailable", &prettydbi()); \
#FIXME we get a guru here but it should be a pretty message  +    \
&viewprettyerror("Registry database backend unavailable", &prettydbi());  goto CUS;
   }
   $dbs = &dbopen("session");
   if (not defined $dbs) {
  -    &printprettyerror("Session database not accessible", &prettydbi());
  +    &viewprettyerror("Session database not accessible", &prettydbi());
       goto CUS;
   }
   
   #   establish CGI Session object
  -my $session;
  -$session = undef;
   CGI::Session->name("registry-sid");
   $session = new CGI::Session(
       "driver:sqlite;serializer:Storable;id:uuid", $sid, { Handle => $dbs, TableName \
=> 'session' }  );
   if (not defined $session) {
  -    &printprettyerror("Session handling failed", "");
  +    &viewprettyerror("Session handling failed", "");
       goto CUS;
   }
  +#   response cookies for session persistency
   $session->expire("+3600s");
  +if ($session->is_new()) {
  +    $response->{header}->{cookie} = $cgi->cookie(
  +        -name    => $session->name(),
  +        -value   => $session->id(),
  +        -expires => sprintf("+%ds", $session->expires()),
  +        -path    => $cgi->url(-absolute => 1)
  +    )
  +}
   
   if ($cfg->{identification}->{mode} eq "ase") {
       #   establish ASE object
  @@ -192,7 +200,7 @@
           -session => $session,
       );
       if (not defined $ase) {
  -        &printprettyerror("Affiliation Services Environment", "");
  +        &viewprettyerror("Affiliation Services Environment", "");
           goto CUS;
       }
   
  @@ -203,7 +211,7 @@
               print $ase->response();
           }
           else {
  -            &printprettyerror("Affiliation Services Environment", $ase->error());
  +            &viewprettyerror("Affiliation Services Environment", $ase->error());
           }
           goto CUS;
       }
  @@ -212,69 +220,53 @@
   #   continue to the pages that require database access
   #
   if    ($requestedpage eq "login") {
  -    $out = '';
  -    $out .= &viewhttp();
  -    $out .= &viewhtmlhead(-menu);
  -    $out .= &viewlogin();
  -    $out .= &viewhtmltail();
  -    print STDOUT &canvas($out);
  +    &viewlogin();
   }
   elsif ($requestedpage eq "logout") {
  -    $out = '';
  -    $out .= &viewhttp();
  -    $out .= &viewhtmlhead(-menu);
  -    $out .= &viewlogout();
  -    $out .= &viewhtmltail();
  -    print STDOUT &canvas($out);
  +    &viewlogout();
   }
   elsif ($requestedpage eq "asecomeback") {
  -    $out = '';
  -    $out .= &viewasecomeback();
  -    print STDOUT &canvas($out);
  +    &viewasecomeback();
   }
   elsif ($requestedpage eq "association") {
  -    $out = '';
  -    $out .= &viewhttpauthrequired("association");
  -    $out .= &viewhtmlhead(-menu);
  -    $out .= &viewassociation();
  -    $out .= &viewhtmltail();
  -    print STDOUT &canvas($out);
  -}
  -elsif ($requestedpage eq "dropxml" and not &uao()) {
  -    $out = '';
  -    $out .= &viewhttp();
  -    $out .= &viewhtmlhead(-menu);
  -    $out .= &viewdropxml();
  -    $out .= &viewhtmltail();
  -    print STDOUT &canvas($out);
  -}
  -elsif ($requestedpage eq "dropxml" and &uao()) {
  -    $out = '';
  -    $out .= &viewhttp("plain/text");
  -    $out .= &viewdropxml();
  -    print STDOUT $out;
  +    &viewassociation();
  +}
  +elsif ($requestedpage eq "dropxml") {
  +    &viewdropxml();
   }
   elsif ($requestedpage eq "ase") {
  -    $out = '';
  -    $out .= &viewhttp();
  -    $out .= &viewhtmlhead(-menu);
  -    $out .= &viewhtmltail();
  -    print STDOUT &canvas($out);
  +    &viewemptypage();
   }
   else {
  -    if (not defined $out) {
  -        $out = '';
  -        $cgi->delete_all();
  -        $out .= &viewhttp();
  -        $out .= &viewhtmlhead(-menu);
  -        $out .= &viewhtmltail();
  -        print STDOUT &canvas($out);
  -    }
  +    $cgi->delete_all();
  +    &viewemptypage();
   }
  +}      #FIXME defer indentation making diff better readable
   
  -#   die gracefully ;-)
  +#   cleanup sequence
   #
   CUS:
  +if ($response->{header}->{redirect}) {
  +    print STDOUT $cgi->redirect(
  +        -nph     => 0,
  +        -uri     => $response->{header}->{redirect},
  +        -type    => $response->{header}->{type},
  +        -status  => $response->{header}->{status},
  +        -expires => $response->{header}->{expires},
  +        -cookie  => $response->{header}->{cookie}
  +        ) . $response->{message}->unfold();
  +}
  +else {
  +    print STDOUT $cgi->header(
  +        -nph     => 0,
  +        -type    => $response->{header}->{type},
  +        -status  => $response->{header}->{status},
  +        -expires => $response->{header}->{expires},
  +        -cookie  => $response->{header}->{cookie}
  +        ) . $response->{message}->unfold();
  +}
  +$response->{message}->destroy();
  +undef $response->{message};
   undef $ase;
   undef $session;
   undef $cgi;
  @@ -283,60 +275,11 @@
   
   #   check whether user agent is openpkg-register
   #
  -sub uao()
  +sub uao ()
   {
       return $cgi->user_agent() =~ \
m:^openpkg-regist(er|ry)/[01][\.ab]\d+[\.ab]\d+$:;  }
   
  -sub httpheader ($$$)
  -{
  -    my ($type, $expires, $refresh) = @_;
  -    my $header = {};
  -    $header->{type} =    $type    || 'text/html';
  -    $header->{expires} = $expires || '+1s';
  -    if ($refresh) {
  -        $header->{refresh} = "$refresh; $myurl";
  -    }
  -
  -    #   determine HTTP response cookies for session persistency
  -    if (defined $session and $session->is_new()) {
  -        $header->{cookie} = $cgi->cookie(
  -            -name    => $session->name(),
  -            -value   => $session->id(),
  -            -expires => sprintf("+%ds", $session->expires()),
  -            -path    => $cgi->url(-absolute => 1)
  -        )
  -    }
  -
  -    return $header;
  -}
  -
  -sub viewhttp ($$$)
  -{
  -    my ($type, $expires, $refresh) = @_;
  -    my $header = {};
  -
  -    $header = &httpheader($type, $expires, $refresh);
  -
  -    return $cgi->header($header);
  -}
  -
  -sub viewhttpauthrequired($$$$)
  -{
  -    my ($page, $type, $expires, $refresh) = @_;
  -    my ($header, $username);
  -    
  -    $header = &httpheader($type, $expires, $refresh);
  -
  -    $username = &identifyusername();
  -    if (not defined $username or $username eq '') {
  -        if    ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
  -            $header->{redirect} = $cgi->redirect(-uri => $ase->url(-action => \
                "login", -mode_during => "ase", -mode_after => $page));
  -        }
  -    }
  -    return $cgi->header($header);
  -}
  -
   sub viewhtmlhead (;$)
   {
       my ($menu) = @_;
  @@ -365,7 +308,6 @@
           $head .= "          </tr>\n";
           $head .= "          <tr>\n";
           $head .= "              <td colspan=\"" . $td . "\">\n";
  -        $head .= &prettyauthinfo("fancy");
           $head .= "              </td>\n";
           $head .= "          </tr>\n";
           $head .= "      </table>\n";
  @@ -384,14 +326,14 @@
       $text = "";
   
       $username = &identifyusername();
  -    if ($username ne "") {
  +    if (defined $username) {
           $text .= "authenticated as " . $boldon . $username . $boldoff;
       }
       else {
           $text .= "you are " . $boldon . "not authenticated" . $boldoff;
       }
   
  -    if    ($cfg->{identification}->{mode} eq "ase") {
  +    if    ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
           $text .= " via ase login";
       }
       elsif ($cfg->{identification}->{mode} eq "basicauth") {
  @@ -445,8 +387,15 @@
   }
   
   sub viewcss () {
  -    my $css = '';
  +    my $css;
   
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/css';
  +    $response->{header}->{expires} = '+3600s';
  +
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $css = '';
       $css .= "/*\n";
       $css .= "**  registry-ui.pl - OpenPKG registration user interface\n";
       $css .= "*/\n";
  @@ -459,7 +408,7 @@
       $css .= "}\n";
       $css .= "DIV.status {\n";
       $css .= "    font-family:     sans-serif, helvetica, arial;\n";
  -    $css .= "    font-size:       66%;\n";
  +    $css .= "    font-size:       100% /* 66% */;\n";
       $css .= "}\n";
       $css .= "BODY.registry DIV.registry {\n";
       $css .= "    background-image: url($myurl?page=jpg&name=bg);\n";
  @@ -548,11 +497,11 @@
       $css .= ".registry TABLE.association TD {\n";
       $css .= "    padding:          0px 10px 0px 10px;\n";
       $css .= "}\n";
  -
  -    return $css;
  +    $response->{message}->append($css);
  +    $response->{message}->undivert(0);
   }
   
  -sub viewjpg () {
  +sub viewjpg ($) {
       my ($name) = @_;
       $name .= ".jpg";
   
  @@ -944,10 +893,17 @@
   EOT
       };
   
  -    return decode_base64($jpg->{$name});
  +    #   HTTP header
  +    $response->{header}->{type} = 'image/gif';
  +    $response->{header}->{expires} = '+3600s';
  +
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(decode_base64($jpg->{$name}));
  +    $response->{message}->undivert(0);
   }
   
  -sub viewgif () {
  +sub viewgif ($) {
       my ($name) = @_;
       $name .= ".gif";
   
  @@ -970,10 +926,17 @@
   EOT
       };
   
  -    return decode_base64($gif->{$name});
  +    #   HTTP header
  +    $response->{header}->{type} = 'image/gif';
  +    $response->{header}->{expires} = '+3600s';
  +
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(decode_base64($gif->{$name}));
  +    $response->{message}->undivert(0);
   }
   
  -sub viewassociationform()
  +sub viewassociationform ()
   {
       my ($html);
       $html = '';
  @@ -985,7 +948,7 @@
       return $html;
   }
   
  -sub viewloginform()
  +sub viewloginform ()
   {
       my $html;
       $html = '';
  @@ -1020,13 +983,10 @@
       return $html;
   }
   
  -sub viewasecomeback()
  +sub viewasecomeback ()
   {
  -    my ($redirect, $username);
  -    my $html;
  -    my $header = {};
  +    my ($html, $username);
   
  -    $html = '';
       $username = &identifyusername();
       if (defined $username) {
   
  @@ -1036,52 +996,52 @@
           $sql = sprintf("UPDATE reg_user SET heartbeat = now() WHERE ( username = \
'%s' );", $username);  $rv = $dbh->do($sql);
           if (not defined $rv) {
  -            $html .= &printprettyerror("updating user $username", prettydbi());
  +            &viewprettyerror("updating user $username", prettydbi());
  +            goto CUS;
           }
           elsif ($rv != 1) {
               $sql = sprintf("INSERT INTO reg_user (username) VALUES ('%s');", \
$username);  $rv = $dbh->do($sql);
               if (not defined $rv) {
  -                $html .= &printprettyerror("inserting user $username", \
prettydbi());  +                &viewprettyerror("inserting user $username", \
prettydbi());  +                goto CUS;
               }
               elsif ($rv != 1) {
  -                $html .= &printprettyerror("creating user $username", \
prettydbi());  +                &viewprettyerror("creating user $username", \
prettydbi());  +                goto CUS;
               }
           }
       }
   
  -    return $html if ($html);
  -    $header->{redirect} = $cgi->redirect(-uri => "$myurl?page=login");
  -    return $cgi->header($header);
  -}
  -
  -sub printprettyerror($$)
  -{
  -    my ($marketingmessage, $technicaldetail) = @_;
  -    my $out;
  -    $out = '';
  -    $out .= &viewhttp();
  -    $out .= &viewhtmlhead();
  -    $out .= &viewprettyerror($marketingmessage, $technicaldetail);
  -    $out .= &viewhtmltail();
  -    print STDOUT &canvas($out);
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/html';
  +    $response->{header}->{expires} = '+1s';
  +    $response->{header}->{redirect} = "$myurl?page=login";
   }
   
  -sub viewprettyerror($$)
  +sub viewprettyerror ($$)
   {
       my ($marketingmessage, $technicaldetail) = @_;
       my $html;
   
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/html';
  +    $response->{header}->{expires} = '+1s';
  +
       $html = '';
       $html .= "<h2>Sorry</h2>\n";
       $html .= "<img src=\"?page=gif;name=icon-x\">&nbsp;an internal <b>ERROR</b> \
                occurred and prevents further processing.<br/>\n";
       $html .= sprintf("<h2>Problem scope</h2>\n%s<br/>\n", $marketingmessage) if \
                (defined $marketingmessage and $marketingmessage ne "");
       $html .= sprintf("<h2>Technical details</h2>\n%s<br/>\n", $technicaldetail) if \
                (defined $technicaldetail and $technicaldetail ne "");
       $html .= "<h2>Please come back later and try again</h2>\nSorry for the \
                inconvenience\n";
  -    return $html
  +
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(&canvas($html));
  +    $response->{message}->undivert(0);
   }
   
  -sub prettydbi()
  +sub prettydbi ()
   {
       my $msg;
       $msg = $DBI::errstr;
  @@ -1090,12 +1050,36 @@
       return $msg;
   }
   
  -sub viewlogin()
  +sub viewemptypage ()
   {
       my ($html, $username);
  +
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/html';
  +    $response->{header}->{expires} = '+1s';
  +
       $html = '';
  +    $html .= &viewhtmlhead(-menu);
  +    $html .= &viewhtmltail();
   
  -    if    ($cfg->{identification}->{mode} eq "ase") {
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(&canvas($html));
  +    $response->{message}->undivert(0);
  +}
  +
  +sub viewlogin ()
  +{
  +    my ($html, $username);
  +
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/html';
  +    $response->{header}->{expires} = '+1s';
  +
  +    $html = '';
  +    $html .= &viewhtmlhead(-menu);
  +
  +    if    ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
           # nop
       }
       elsif ($cfg->{identification}->{mode} eq "basicauth") {
  @@ -1111,18 +1095,26 @@
           # nop, misconfigured
       }
   
  +    #   identify username after login attempt
       $username = &identifyusername();
  -    if ($username ne "") {
  +
  +    if (defined $username) {
           $html .= "<h2>Login&nbsp;successful</h2>\n";
           $html .= "Welcome,<br>\n" . $username . "<br>\n";
       }
       else {
           $html .= "<h2>Login&nbsp;failed</h2>\n";
       }
  -    return $html;
  +
  +    $html .= &viewhtmltail();
  +
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(&canvas($html));
  +    $response->{message}->undivert(0);
   }
   
  -sub viewlogoutform()
  +sub viewlogoutform ()
   {
       my $html;
       $html = '';
  @@ -1150,12 +1142,18 @@
       return $html;
   }
   
  -sub viewlogout()
  +sub viewlogout ()
   {
  -    my ($html);
  +    my ($html, $username);
  +
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/html';
  +    $response->{header}->{expires} = '+1s';
  +
       $html = '';
  +    $html .= &viewhtmlhead(-menu);
   
  -    if    ($cfg->{identification}->{mode} eq "ase") {
  +    if    ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
           # nop
       }
       elsif ($cfg->{identification}->{mode} eq "basicauth") {
  @@ -1171,13 +1169,24 @@
           # nop, misconfigured
       }
   
  -    $session->delete();
  -    $session = undef;
  -    $html .= "<h2>Logout&nbsp;completed</h2>\n";
  -    return $html;
  +    #   identify username after logout attempt
  +    $username = &identifyusername();
  +    if (not defined $username) {
  +        $html .= "<h2>Logged&nbsp;out</h2>\n";
  +    }
  +    else {
  +        $html .= "<h2>Logout&nbsp;failed;</h2>\n";
  +    }
  +
  +    $html .= &viewhtmltail();
  +
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(&canvas($html));
  +    $response->{message}->undivert(0);
   }
   
  -sub viewdropxmlform()
  +sub viewdropxmlform ()
   {
       my $html;
       $html = '';
  @@ -1189,7 +1198,7 @@
       return $html;
   }
   
  -sub execassociation()
  +sub execassociation ()
   {
       my $html;
       my ($formstruct, $username, $headerout);
  @@ -1273,30 +1282,40 @@
       return $html;
   }
   
  -sub viewassociation()
  +sub viewassociation ()
   {
  -    my $html;
  -    my $username;
  +    my ($html, $username);
  +
  +    #   HTTP header
  +    $response->{header}->{type} = 'text/html';
  +    $response->{header}->{expires} = '+1s';
   
       $html = '';
  +    $html .= &viewhtmlhead(-menu);
       $username = &identifyusername();
       if (not defined $username) {
           $html .= "<h2>Access&nbsp;denied</h2>";
           $html .= "Login to authenticate";
  -        return $html;
       }
  -    $html .= sprintf("<h2>Instances related to %s</h2>", $username);
  -    $html .= "<hr>\n";
  +    else {
  +        $html .= sprintf("<h2>Instances related to %s</h2>", $username);
  +        $html .= "<hr>\n";
  +
  +        $html .= &execassociation();
  +        $html .= &condassociation("arrival", $username);
  +        $html .= &condassociation("active", $username);
  +        $html .= &condassociation("departure", $username);
  +    }
   
  -    $html .= &execassociation();
  -    $html .= &condassociation("arrival", $username);
  -    $html .= &condassociation("active", $username);
  -    $html .= &condassociation("departure", $username);
  +    $html .= &viewhtmltail();
   
  -    return $html;
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(&canvas($html));
  +    $response->{message}->undivert(0);
   }
   
  -sub condassociation($)
  +sub condassociation ($)
   {
       my ($mode, $username) = @_;
       my ($html, $where, $headline);
  @@ -1405,7 +1424,7 @@
       $html .= "</table>";
   }
   
  -sub execdropxml()
  +sub execdropxml ()
   {
       my $html;
       my $data;
  @@ -1634,41 +1653,54 @@
       return($html);
   }
   
  -sub viewdropxml()
  +sub viewdropxml ()
   {
       my $html;
  -    my $data;
  +
  +    #   HTTP header
  +    $response->{header}->{type} = &uao() ? 'plain/text' : 'text/html';
  +    $response->{header}->{expires} = '+1s';
  +
       $html = '';
  +    if (not &uao()) {
  +        $html .= &viewhtmlhead(-menu);
  +    }
   
       $html .= &execdropxml();
  -    return $html if (&uao());
   
  -    if (defined $cgi->param("data")) {
  -        $html .= "<h2>Correct registration data below</h2>";
  -    }
  -    else {
  -        $html .= "<h2>Paste registration data below</h2>";
  +    if (not &uao()) {
  +        if (defined $cgi->param("data")) {
  +            $html .= "<h2>Correct registration data below</h2>";
  +        }
  +        else {
  +            $html .= "<h2>Paste registration data below</h2>";
  +        }
  +
  +        $html .= "      <table class=\"menu\">\n";
  +        $html .= "          <tr>\n";
  +        $html .= "              <td>\n";
  +        $html .= $cgi->start_form(-action => "$myurl?page=dropxml");
  +        $html .= "<div>" . $cgi->textarea(
  +            -name       => 'data',
  +            -columns    => 80,
  +            -rows       => 15,
  +            -default    => '',
  +        ) . "</div>\n";
  +        $html .= "<div>" . $cgi->submit('submit','register') . "</div>";
  +        $html .= $cgi->end_form;
  +        $html .= "              </td>\n";
  +        $html .= "          </tr>\n";
  +        $html .= "      </table>\n";
  +        $html .= &viewhtmltail();
       }
   
  -    $html .= "      <table class=\"menu\">\n";
  -    $html .= "          <tr>\n";
  -    $html .= "              <td>\n";
  -    $html .= $cgi->start_form(-action => "$myurl?page=dropxml");
  -    $html .= "<div>" . $cgi->textarea(
  -        -name       => 'data',
  -        -columns    => 80,
  -        -rows       => 15,
  -        -default    => '',
  -    ) . "</div>\n";
  -    $html .= "<div>" . $cgi->submit('submit','register') . "</div>";
  -    $html .= $cgi->end_form;
  -    $html .= "              </td>\n";
  -    $html .= "          </tr>\n";
  -    $html .= "      </table>\n";
  -    return $html;
  +    #   HTTP message
  +    $response->{message}->divert("message");
  +    $response->{message}->append(&uao() ? $html : &canvas($html));
  +    $response->{message}->undivert(0);
   }
   
  -sub printjscheckallboxes()
  +sub printjscheckallboxes ()
   {
       my $js;
       $js = <<'EOT';
  @@ -1689,7 +1721,7 @@
       return $js;
   }
   
  -sub canvas($)
  +sub canvas ($)
   {
       my ($page) = @_;
       my ($http, $head, $body, $canvas);
  @@ -1748,7 +1780,7 @@
       $rv = $dbs->do("DELETE FROM cache WHERE ( expires <= ? );", undef, time()) or \
die $dbs->errstr(); #FIXME  
       #   dig in the cache
  -    $sth = $dbs->prepare_cached("SELECT content_type, expires, content FROM cache \
WHERE url = ?;") or die $dbs->errstr(); #FIXME  +    $sth = $dbs->prepare("SELECT \
content_type, expires, content FROM cache WHERE url = ?;") or die $dbs->errstr(); \
#FIXME  $sth->execute($url) or die $dbs->errstr(); #FIXME
       $rv = $sth->fetchrow_hashref;
   
  @@ -1796,7 +1828,7 @@
       return $content_type, $expires, $content;
   }
   
  -sub identifyusername()
  +sub identifyusername ()
   {
       my $username;
       $username = undef;
  @@ .
______________________________________________________________________
The OpenPKG Project                                    www.openpkg.org
CVS Repository Commit List                     openpkg-cvs@openpkg.org


[prev in list] [next in list] [prev in thread] [next in thread] 

Configure | About | News | Add a list | Sponsored by KoreLogic