OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Thomas Lotterer
Root: /v/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-registry Date: 24-Nov-2005 22:27:12
Branch: HEAD Handle: 2005112421271100
Modified files:
openpkg-registry registry-db.pl registry-ui.pl
Log:
drag canvas from remote url, cache it into database and integrate own
page inside
Summary:
Revision Changes Path
1.6 +26 -0 openpkg-registry/registry-db.pl
1.14 +118 -8 openpkg-registry/registry-ui.pl
____________________________________________________________________________
patch -p0 <<'@@ .'
Index: openpkg-registry/registry-db.pl
============================================================================
$ cvs diff -u -r1.5 -r1.6 registry-db.pl
--- openpkg-registry/registry-db.pl 24 Nov 2005 11:56:46 -0000 1.5
+++ openpkg-registry/registry-db.pl 24 Nov 2005 21:27:11 -0000 1.6
@@ -182,6 +182,9 @@
$sql = &schemasession2();
$rv = $dbh->do($sql);
print "[schema.2]\nrv=".$rv." message=".$dbh->errstr."\n\n"; die if
($dbh->errstr =~ m|ERROR|);
+ $sql = &schemasession3();
+ $rv = $dbh->do($sql);
+ print "[schema.3]\nrv=".$rv." message=".$dbh->errstr."\n\n"; die if
($dbh->errstr =~ m|ERROR|);
$sql = "INSERT INTO config VALUES ( 'version', '".$progvers."' );";
$rv = $dbh->do($sql);
print "[schema.v]\nrv=".$rv." message=".$dbh->errstr."\n\n"; die if
($dbh->errstr =~ m|ERROR|);
@@ -381,6 +384,29 @@
EOT
}
+sub schemasession3()
+{
+ return <<'EOT'
+ -- OpenPKG cache
+ CREATE TABLE cache (
+ url TEXT NOT NULL
+ PRIMARY KEY
+ UNIQUE ON CONFLICT REPLACE,
+ -- URL to be cached
+ -- [http://meta.openpkg.org/]
+ content_type TEXT,
+ -- HTTP content type
+ -- [text/html]
+ expires INTEGER NOT NULL,
+ -- Invalidation time in sec since 1970
+ -- [121343]
+ content BLOB
+ -- Session Data (Storage based)
+ -- [...]
+ );
+EOT
+}
+
sub schemaregistry()
{
return <<'EOT'
@@ .
patch -p0 <<'@@ .'
Index: openpkg-registry/registry-ui.pl
============================================================================
$ cvs diff -u -r1.13 -r1.14 registry-ui.pl
--- openpkg-registry/registry-ui.pl 24 Nov 2005 11:56:46 -0000 1.13
+++ openpkg-registry/registry-ui.pl 24 Nov 2005 21:27:11 -0000 1.14
@@ -70,6 +70,9 @@
$cfg->{db}->{registry}->{tablespace}="registry";
$cfg->{db}->{registry}->{host}="127.0.0.1";
$cfg->{db}->{session}->{dbfile}="$PREFIX/var/openpkg-registry/ui/session.db";
+$cfg->{canvas}->{url}="http://meta.openpkg.org";
+$cfg->{canvas}->{mark_head}="<!-- CANVAS: HEAD -->";
+$cfg->{canvas}->{mark_body}="<!-- CANVAS: BODY -->";
# create objects
my $cgi = new CGI;
@@ -205,13 +208,13 @@
my $out;
$out = '';
$out .= &viewlogin();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
elsif ($cgi->param("page") eq "logout") {
my $out;
$out = '';
$out .= &viewlogout();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
elsif ($cgi->param("page") eq "association") {
my $out;
@@ -225,7 +228,7 @@
$out .= &viewlogoutform();
$out .= &viewassociation();
$out .= &viewhtmltail();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
elsif ($cgi->param("page") eq "dropxml" and not &uao()) {
my $out;
@@ -239,14 +242,14 @@
$out .= &viewlogoutform();
$out .= &viewdropxml();
$out .= &viewhtmltail();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
elsif ($cgi->param("page") eq "dropxml" and &uao()) {
my $out;
$out = '';
$out .= &viewhttp("plain/text");
$out .= &viewdropxml();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
elsif ($cgi->param("page") eq "ase") {
my $out;
@@ -255,7 +258,7 @@
$out .= &viewhtmlhead();
$out .= &viewase();
$out .= &viewhtmltail();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
else {
my $out;
@@ -269,7 +272,7 @@
$out .= &viewloginform();
$out .= &viewlogoutform();
$out .= &viewhtmltail();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
# die gracefully ;-)
@@ -916,7 +919,7 @@
$out .= &viewmainform();
$out .= &viewprettyerror($marketingmessage, $technicaldetail);
$out .= &viewhtmltail();
- print STDOUT $out;
+ print STDOUT &canvas($out);
}
sub viewprettyerror($$)
@@ -1541,6 +1544,113 @@
return $js;
}
+sub canvas($)
+{
+ my ($page) = @_;
+ my ($http, $head, $body, $canvas);
+
+ $http = $page;
+ $http =~ s|<html>.*$||s;
+ $http = "Foo: bar\n" . $http;
+
+ $head = $page;
+ $head =~ s|^.*<head>||s;
+ $head =~ s|</head>.*||s;
+
+ $body = $page;
+ $body =~ s|^.*<body[^>]*>||s;
+ $body =~ s|</body>.*||s;
+
+
+ (undef, undef, $canvas) = &fetchurlcached($cfg->{canvas}->{url});
+ if (not defined $canvas or $canvas eq "") {
+ $canvas =
+ "<html>\n" .
+ " <head>\n" .
+ $cfg->{canvas}->{mark_head} . "\n" .
+ " </head>\n" .
+ " <body class=\"registry\">\n" .
+ $cfg->{canvas}->{mark_body} . "\n" .
+ " </body>\n" .
+ "</html>\n";
+ }
+
+ $canvas =~ s|$cfg->{canvas}->{mark_head}|$head|;
+ $canvas =~ s|$cfg->{canvas}->{mark_body}|$body|;
+ return $http . $canvas;
+}
+
+sub fetchurlcached ($)
+{
+ my ($url) = @_;
+ my ($content_type, $expires, $content);
+ undef $content;
+
+ ($content_type, $expires, $content) = &getcache($url);
+ ($content_type, $expires, $content) = &fetchurl($url) if (not defined
$content);
+ &setcache($url, $content_type, $expires, $content) if (defined $content);
+
+ return $content_type, $expires, $content;
+}
+
+sub getcache ($)
+{
+ my ($url) = @_;
+ my ($content_type, $expires, $content, $rv, $sth);
+ ($content_type, $expires, $content) = undef;
+
+ # invalidate expired records
+ $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->execute($url) or die $dbs->errstr(); #FIXME
+ $rv = $sth->fetchrow_hashref;
+
+ $content_type = $rv->{content_type};
+ $expires = $rv->{expires};
+ $content = $rv->{content};
+ return $content_type, $expires, $content;
+}
+
+sub setcache ($$$$)
+{
+ my ($url, $content_type, $expires, $content) = @_;
+
+ $expires = time() + 600 if (not defined $expires);
+
+ $rv = $dbs->do("INSERT INTO cache (url, content_type, expires, content)
VALUES (?, ?, ?, ?);",
+ undef,
+ $url, $content_type, $expires, $content) or die
$dbs->errstr(); #FIXME
+}
+
+sub fetchurl ($)
+{
+ my ($url) = @_;
+ my ($content_type, $expires, $content, $rv, $sth);
+ ($content_type, $expires, $content) = undef;
+
+ my $response;
+ use HTTP::Response;
+ use Socket;
+ use Net::HTTP;
+ use LWP::UserAgent;
+ my $ua = new LWP::UserAgent;
+ $ua->agent("openpkg-$progname/$progvers");
+ $ua->timeout(20);
+ $ua->max_size(1*1024*1024);
+ $ua->max_redirect(2);
+ $ua->protocols_allowed([ 'http', 'https']);
+ $response = $ua->get($url);
+ if ($response->is_success) {
+ $content_type = $response->content_type;
+ $expires = $response->expires;
+ $content = $response->content;
+ }
+
+ return $content_type, $expires, $content;
+}
+
sub identifyusername()
{
my $username;
@@ .
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [email protected]
