* Start of a basic Catalyst web interface.

This commit is contained in:
Eelco Dolstra 2008-10-28 10:19:31 +00:00
parent c181fc8703
commit b250fa6094
21 changed files with 928 additions and 0 deletions

View file

@ -0,0 +1,19 @@
# IMPORTANT: if you delete this file your app will not work as
# expected. you have been warned
use inc::Module::Install;
name 'HydraFrontend';
all_from 'lib/HydraFrontend.pm';
requires 'Catalyst::Runtime' => '5.7015';
requires 'Catalyst::Plugin::ConfigLoader';
requires 'Catalyst::Plugin::Static::Simple';
requires 'Catalyst::Action::RenderView';
requires 'parent';
requires 'Config::General'; # This should reflect the config file format you've chosen
# See Catalyst::Plugin::ConfigLoader for supported formats
catalyst;
install_script glob('script/*.pl');
auto_install;
WriteAll;

View file

@ -0,0 +1 @@
name HydraFrontend

View file

@ -0,0 +1,20 @@
package HydraFrontend;
use strict;
use warnings;
use Catalyst::Runtime '5.70';
use parent qw/Catalyst/;
use Catalyst qw/-Debug
ConfigLoader
Static::Simple
StackTrace
/;
our $VERSION = '0.01';
__PACKAGE__->config( name => 'HydraFrontend' );
__PACKAGE__->setup();
1;

View file

@ -0,0 +1,86 @@
package HydraFrontend::Controller::Root;
use strict;
use warnings;
use parent 'Catalyst::Controller';
#
# Sets the actions in this controller to be registered with no prefix
# so they function identically to actions created in MyApp.pm
#
__PACKAGE__->config->{namespace} = '';
sub error {
my ($c, $msg) = @_;
$c->stash->{template} = 'error.tt';
$c->stash->{error} = $msg;
$c->response->status(404);
}
sub getBuild {
my ($c, $id) = @_;
(my $build) = $c->model('DB::Builds')->search({ id => $id });
return $build;
}
sub index :Path :Args(0) {
my ( $self, $c ) = @_;
$c->stash->{template} = 'index.tt';
$c->stash->{builds} = [$c->model('DB::Builds')->all];
}
sub default :Path {
my ( $self, $c ) = @_;
error($c, "Page not found.");
}
sub build :Local {
my ( $self, $c, $id ) = @_;
my $build = getBuild($c, $id);
return error($c, "Build with ID $id doesn't exist.") if !defined $build;
$c->stash->{template} = 'build.tt';
$c->stash->{build} = $build;
$c->stash->{id} = $id;
}
sub log :Local {
my ( $self, $c, $id, $logPhase ) = @_;
my $build = getBuild($c, $id);
return error($c, "Build with ID $id doesn't exist.") if !defined $build;
my $log = $build->buildlogs->find({logphase => $logPhase});
return error($c, "Build $id doesn't have a log phase named <tt>$logPhase</tt>.") if !defined $log;
$c->stash->{template} = 'log.tt';
$c->stash->{id} = $id;
$c->stash->{log} = $log;
# !!! should be done in the view (as a TT plugin).
$c->stash->{logtext} = loadLog($log->path);
}
sub loadLog {
my ($path) = @_;
# !!! all a quick hack
if ($path =~ /.bz2$/) {
return `cat $path | bzip2 -d`;
} else {
return `cat $path`;
}
}
sub end : ActionClass('RenderView') {}
1;

View file

@ -0,0 +1,36 @@
package HydraFrontend::Model::DB;
use strict;
use base 'Catalyst::Model::DBIC::Schema';
__PACKAGE__->config(
schema_class => 'HydraFrontend::Schema',
connect_info => [
'dbi:SQLite:../hydra.sqlite',
],
);
=head1 NAME
HydraFrontend::Model::DB - Catalyst DBIC Schema Model
=head1 SYNOPSIS
See L<HydraFrontend>
=head1 DESCRIPTION
L<Catalyst::Model::DBIC::Schema> Model using schema L<HydraFrontend::Schema>
=head1 AUTHOR
Eelco Dolstra
=head1 LICENSE
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
1;

View file

@ -0,0 +1,16 @@
package HydraFrontend::Schema;
use strict;
use warnings;
use base 'DBIx::Class::Schema';
__PACKAGE__->load_classes;
# Created by DBIx::Class::Schema::Loader v0.04005 @ 2008-10-25 22:23:27
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:iW1lrJQVyiDiAYhJBy9/iQ
# You can replace this text with custom content, and it will be preserved on regeneration
1;

View file

@ -0,0 +1,33 @@
package HydraFrontend::Schema::Buildlogs;
use strict;
use warnings;
use base 'DBIx::Class';
__PACKAGE__->load_components("Core");
__PACKAGE__->table("buildLogs");
__PACKAGE__->add_columns(
"buildid",
{ data_type => "integer", is_nullable => 0, size => undef },
"logphase",
{ data_type => "text", is_nullable => 0, size => undef },
"path",
{ data_type => "text", is_nullable => 0, size => undef },
"type",
{ data_type => "text", is_nullable => 0, size => undef },
);
__PACKAGE__->set_primary_key("buildid", "logphase");
__PACKAGE__->belongs_to(
"buildid",
"HydraFrontend::Schema::Builds",
{ id => "buildid" },
);
# Created by DBIx::Class::Schema::Loader v0.04005 @ 2008-10-25 22:23:27
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:01Br5qFsV84USpzqnjk7cw
# You can replace this text with custom content, and it will be preserved on regeneration
1;

View file

@ -0,0 +1,33 @@
package HydraFrontend::Schema::Buildproducts;
use strict;
use warnings;
use base 'DBIx::Class';
__PACKAGE__->load_components("Core");
__PACKAGE__->table("buildProducts");
__PACKAGE__->add_columns(
"buildid",
{ data_type => "integer", is_nullable => 0, size => undef },
"type",
{ data_type => "text", is_nullable => 0, size => undef },
"subtype",
{ data_type => "text", is_nullable => 0, size => undef },
"path",
{ data_type => "text", is_nullable => 0, size => undef },
);
__PACKAGE__->set_primary_key("buildid", "type", "subtype");
__PACKAGE__->belongs_to(
"buildid",
"HydraFrontend::Schema::Builds",
{ id => "buildid" },
);
# Created by DBIx::Class::Schema::Loader v0.04005 @ 2008-10-25 22:23:27
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:jYe9p4xG2Ujnf6TsfeE7tA
# You can replace this text with custom content, and it will be preserved on regeneration
1;

View file

@ -0,0 +1,42 @@
package HydraFrontend::Schema::Builds;
use strict;
use warnings;
use base 'DBIx::Class';
__PACKAGE__->load_components("Core");
__PACKAGE__->table("builds");
__PACKAGE__->add_columns(
"id",
{ data_type => "integer", is_nullable => 0, size => undef },
"timestamp",
{ data_type => "integer", is_nullable => 0, size => undef },
"name",
{ data_type => "text", is_nullable => 0, size => undef },
"description",
{ data_type => "text", is_nullable => 0, size => undef },
"drvpath",
{ data_type => "text", is_nullable => 0, size => undef },
"outpath",
{ data_type => "text", is_nullable => 0, size => undef },
"buildstatus",
{ data_type => "integer", is_nullable => 0, size => undef },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->has_many(
"buildlogs",
"HydraFrontend::Schema::Buildlogs",
{ "foreign.buildid" => "self.id" },
);
__PACKAGE__->has_many(
"buildproducts",
"HydraFrontend::Schema::Buildproducts",
{ "foreign.buildid" => "self.id" },
);
# Created by DBIx::Class::Schema::Loader v0.04005 @ 2008-10-25 22:23:27
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:gxVH+2KWcgU41JOl9BbHFA
1;

View file

@ -0,0 +1,8 @@
package HydraFrontend::View::TT;
use strict;
use base 'Catalyst::View::TT';
__PACKAGE__->config(TEMPLATE_EXTENSION => '.tt');
1;

View file

@ -0,0 +1,65 @@
[% WRAPPER layout.tt title="Hydra Overview" %]
[% USE date %]
<h1>Build [% id %]</h1>
<h2>Information</h2>
<table>
<tr>
<th>Build ID:</th>
<td>[% build.id %]</td>
</tr>
<tr>
<th>Job name:</th>
<td>[% build.name %]</td>
</tr>
<tr>
<th>Description:</th>
<td>[% build.description %]</td>
</tr>
<tr>
<th>Time added:</th>
<td>[% date.format(build.timestamp, '%Y-%m-%d %H:%M:%S') %]</td>
</tr>
<tr>
<th>Derivation store path:</th>
<td><tt>[% build.drvpath %]</tt></td>
</tr>
<tr>
<th>Output store path:</th>
<td><tt>[% build.outpath %]</tt></td>
</tr>
</table>
<h2>Build products</h2>
<ul>
[% FOREACH product IN build.buildproducts -%]
<li>
[% SWITCH product.type %]
[% CASE "nix-build" %]
Nix build of path <tt>[% product.path %]</tt>
[% END %]
</li>
[% END -%]
</ul>
<h2>Logs</h2>
<table>
<tr><th>Phase</th></tr>
[% FOREACH log IN build.buildlogs -%]
<tr>
<td><a href="[% c.uri_for('/log' build.id log.logphase) %]">[% log.logphase %]</a></td>
</tr>
[% END -%]
</table>
[% END %]

View file

@ -0,0 +1,7 @@
[% WRAPPER layout.tt title="Hydra Overview" %]
<h1>Error</h1>
<p>I'm very sorry, but an error occurred: <span class="error-msg">[% error %]</span></p>
[% END %]

View file

@ -0,0 +1,153 @@
body
{
font-family: sans-serif;
background: white;
margin: 2em 1em 2em 1em;
}
h1, h2, h3 {
font-weight: bold;
color: #005aa0;
}
h1 {
font-size: 220%;
}
h2 {
font-size: 130%;
}
h3 {
font-size: 100%;
}
table {
empty-cells: show;
border-collapse: collapse;
border-spacing: 0px;
}
th {
text-align: center;
font-weight: bold;
}
td, th {
padding: 2px 5px;
border: solid black 1px;
}
th {
background: #ffffc0;
}
td.pkgname {
font-size: 140%;
font-weight: bold;
color: #005aa0;
background: #ffffe0;
}
td.pkgname table {
border: none;
border-spacing: 0px;
}
td.pkgname table td {
border: none;
}
td.pkgname td.pkgname {
width: 100%;
}
td.reltype {
font-weight: bold;
color: #400000;
}
td.date, span.date, span.svnrev {
color: #400000;
}
a:link { color: #0048b3; }
a:visited { color: #002a6a; }
a:hover { background: #ffffcd; }
span.relname {
font-weight: bold;
}
span.filename, span.command {
font-family: monospace;
}
span.md5 {
font-family: monospace;
color: #400000;
}
.failurewarning {
font-weight: bold;
color: red;
}
p.failurewarning {
font-size: 120%;
}
span.system {
font-style: italic;
}
table.derivationList {
margin-left: 2em;
margin-right: 2em;
}
table.derivationList, table.derivationList td, table.derivationList th {
border: 1px solid #808080;
}
table.derivationList tr.odd {
background: #f0f0f0;
}
table.derivationList td {
vertical-align: top;
}
table.derivationList td.system {
font-style: italic;
}
a {
text-decoration: none;
}
a:hover, a:visited:hover {
text-decoration: underline;
}
img {
border-style: none;
}
table.buildfarmResults td, table.buildfarmResults th {
border: none;
}
td.buildfarmMainColumn {
background-color: #E0E0E0;
border: solid;
}
span.error-msg {
color: red;
}
pre.buildlog {
border: 1px solid black;
padding: 0.3em;
}

View file

@ -0,0 +1,18 @@
[% WRAPPER layout.tt title="Hydra Overview" %]
[% USE date %]
<h1>All builds</h1>
<table>
<tr><th>Id</th><th>Attribute name</th><th>Timestamp</th><th>Description</th></tr>
[% FOREACH build IN builds -%]
<tr>
<td><a href="[% c.uri_for('/build' build.id) %]">[% build.id %]</a></td>
<td>[% build.name %]</td>
<td>[% date.format(build.timestamp, '%Y-%m-%d %H:%M:%S') %]</td>
<td>[% build.description %]</td>
</tr>
[% END -%]
</table>
[% END %]

View file

@ -0,0 +1,24 @@
[% USE date -%]
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<title>[% title %]</title>
<link rel="stylesheet" href="/hydra.css" type="text/css" />
</head>
<body>
<div class="content">
[% content %]
</div>
<div class="footer">
<hr />
Generated at [% date.format %].
</div>
</body>
</html>

View file

@ -0,0 +1,10 @@
[% WRAPPER layout.tt title="Hydra Overview" %]
<h1>Build log <tt>[% log.logphase %] of build ID [% id %]</h1>
<!-- !!! escaping -->
<pre class="buildlog">
[% logtext -%]
</pre>
[% END %]

View file

@ -0,0 +1,37 @@
#!/var/run/current-system/sw/bin/perl -w
BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use HydraFrontend;
HydraFrontend->run;
1;
=head1 NAME
hydrafrontend_cgi.pl - Catalyst CGI
=head1 SYNOPSIS
See L<Catalyst::Manual>
=head1 DESCRIPTION
Run a Catalyst application as a cgi script.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,74 @@
#!/var/run/current-system/sw/bin/perl -w
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Catalyst::Helper;
my $force = 0;
my $mech = 0;
my $help = 0;
GetOptions(
'nonew|force' => \$force,
'mech|mechanize' => \$mech,
'help|?' => \$help
);
pod2usage(1) if ( $help || !$ARGV[0] );
my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
pod2usage(1) unless $helper->mk_component( 'HydraFrontend', @ARGV );
1;
=head1 NAME
hydrafrontend_create.pl - Create a new Catalyst Component
=head1 SYNOPSIS
hydrafrontend_create.pl [options] model|view|controller name [helper] [options]
Options:
-force don't create a .new file where a file to be created exists
-mechanize use Test::WWW::Mechanize::Catalyst for tests if available
-help display this help and exits
Examples:
hydrafrontend_create.pl controller My::Controller
hydrafrontend_create.pl controller My::Controller BindLex
hydrafrontend_create.pl -mechanize controller My::Controller
hydrafrontend_create.pl view My::View
hydrafrontend_create.pl view MyView TT
hydrafrontend_create.pl view TT TT
hydrafrontend_create.pl model My::Model
hydrafrontend_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
dbi:SQLite:/tmp/my.db
hydrafrontend_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
dbi:Pg:dbname=foo root 4321
See also:
perldoc Catalyst::Manual
perldoc Catalyst::Manual::Intro
=head1 DESCRIPTION
Create a new Catalyst Component.
Existing component files are not overwritten. If any of the component files
to be created already exist the file will be written with a '.new' suffix.
This behavior can be suppressed with the C<-force> option.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,79 @@
#!/var/run/current-system/sw/bin/perl -w
BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
use HydraFrontend;
my $help = 0;
my ( $listen, $nproc, $pidfile, $manager, $detach, $keep_stderr );
GetOptions(
'help|?' => \$help,
'listen|l=s' => \$listen,
'nproc|n=i' => \$nproc,
'pidfile|p=s' => \$pidfile,
'manager|M=s' => \$manager,
'daemon|d' => \$detach,
'keeperr|e' => \$keep_stderr,
);
pod2usage(1) if $help;
HydraFrontend->run(
$listen,
{ nproc => $nproc,
pidfile => $pidfile,
manager => $manager,
detach => $detach,
keep_stderr => $keep_stderr,
}
);
1;
=head1 NAME
hydrafrontend_fastcgi.pl - Catalyst FastCGI
=head1 SYNOPSIS
hydrafrontend_fastcgi.pl [options]
Options:
-? -help display this help and exits
-l -listen Socket path to listen on
(defaults to standard input)
can be HOST:PORT, :PORT or a
filesystem path
-n -nproc specify number of processes to keep
to serve requests (defaults to 1,
requires -listen)
-p -pidfile specify filename for pid file
(requires -listen)
-d -daemon daemonize (requires -listen)
-M -manager specify alternate process manager
(FCGI::ProcManager sub-class)
or empty string to disable
-e -keeperr send error messages to STDOUT, not
to the webserver
=head1 DESCRIPTION
Run a Catalyst application as fastcgi.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,114 @@
#!/var/run/current-system/sw/bin/perl -w
BEGIN {
$ENV{CATALYST_ENGINE} ||= 'HTTP';
$ENV{CATALYST_SCRIPT_GEN} = 31;
require Catalyst::Engine::HTTP;
}
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
my $debug = 0;
my $fork = 0;
my $help = 0;
my $host = undef;
my $port = $ENV{HYDRAFRONTEND_PORT} || $ENV{CATALYST_PORT} || 3000;
my $keepalive = 0;
my $restart = $ENV{HYDRAFRONTEND_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
my $restart_delay = 1;
my $restart_regex = '(?:/|^)(?!\.#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$';
my $restart_directory = undef;
my $follow_symlinks = 0;
my @argv = @ARGV;
GetOptions(
'debug|d' => \$debug,
'fork' => \$fork,
'help|?' => \$help,
'host=s' => \$host,
'port=s' => \$port,
'keepalive|k' => \$keepalive,
'restart|r' => \$restart,
'restartdelay|rd=s' => \$restart_delay,
'restartregex|rr=s' => \$restart_regex,
'restartdirectory=s@' => \$restart_directory,
'followsymlinks' => \$follow_symlinks,
);
pod2usage(1) if $help;
if ( $restart && $ENV{CATALYST_ENGINE} eq 'HTTP' ) {
$ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
}
if ( $debug ) {
$ENV{CATALYST_DEBUG} = 1;
}
# This is require instead of use so that the above environment
# variables can be set at runtime.
require HydraFrontend;
HydraFrontend->run( $port, $host, {
argv => \@argv,
'fork' => $fork,
keepalive => $keepalive,
restart => $restart,
restart_delay => $restart_delay,
restart_regex => qr/$restart_regex/,
restart_directory => $restart_directory,
follow_symlinks => $follow_symlinks,
} );
1;
=head1 NAME
hydrafrontend_server.pl - Catalyst Testserver
=head1 SYNOPSIS
hydrafrontend_server.pl [options]
Options:
-d -debug force debug mode
-f -fork handle each request in a new process
(defaults to false)
-? -help display this help and exits
-host host (defaults to all)
-p -port port (defaults to 3000)
-k -keepalive enable keep-alive connections
-r -restart restart when files get modified
(defaults to false)
-rd -restartdelay delay between file checks
-rr -restartregex regex match files that trigger
a restart when modified
(defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
-restartdirectory the directory to search for
modified files, can be set mulitple times
(defaults to '[SCRIPT_DIR]/..')
-follow_symlinks follow symlinks in search directories
(defaults to false. this is a no-op on Win32)
See also:
perldoc Catalyst::Manual
perldoc Catalyst::Manual::Intro
=head1 DESCRIPTION
Run a Catalyst Testserver for this application.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

View file

@ -0,0 +1,53 @@
#!/var/run/current-system/sw/bin/perl -w
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
use Catalyst::Test 'HydraFrontend';
my $help = 0;
GetOptions( 'help|?' => \$help );
pod2usage(1) if ( $help || !$ARGV[0] );
print request($ARGV[0])->content . "\n";
1;
=head1 NAME
hydrafrontend_test.pl - Catalyst Test
=head1 SYNOPSIS
hydrafrontend_test.pl [options] uri
Options:
-help display this help and exits
Examples:
hydrafrontend_test.pl http://localhost/some_action
hydrafrontend_test.pl /some_action
See also:
perldoc Catalyst::Manual
perldoc Catalyst::Manual::Intro
=head1 DESCRIPTION
Run a Catalyst action from the command line.
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut