chronos
view release on metacpan or search on metacpan
# Then we send the page. The action does not send the page itself.
$self->sendpage;
return OK;
}
}
# This function returns the two-letter language code of the passed username. The
# default is English, even though the language should always be defined.
sub lang {
my $self = shift;
my $dbh = $self->dbh;
my $user_quoted = $dbh->quote( $self->user );
my $lang =
$dbh->selectrow_array("SELECT lang FROM user WHERE user = $user_quoted")
|| 'en';
return $lang;
}
# This function prints a standard header.
sub header {
my $self = shift;
my $object = $self->action->object;
my $user = $self->user;
my $text = $self->gettext;
my $dbh = $self->dbh;
my $uri = $self->{r}->uri;
my ( $year, $month, $day ) = $self->day;
# If the user is viewing today's showday, refresh every hour. When the user
# leaves for the night, he'll come back in the morning with a showday
# automagically showing tomorrow! (or today, whatever)
my @today = Today();
if ( $self->{r}->param('action') eq 'showday'
and $today[0] == $year
and $today[1] == $month
and $today[2] == $day )
{
$self->{r}->header_out( 'Refresh',
"3600;url=$uri?action=showday&object=$object" );
}
# That's the standard header. Note the use of Chronos::stylesheet() and
# Chronos::javascript().
$self->{page} .= <<EOF;
<html>
<head>
<title>Chronos $VERSION: $object</title>
<link rel="stylesheet" href="@{[$self->stylesheet]}" type="text/css">
<script type="text/javascript">
@{[$self->javascript]}
</script>
</head>
<body>
<table width="100%">
<tr><td>
<table width="100%" cellspacing=0>
<tr>
<td class=top>Chronos $VERSION - <a class=header href="$uri?action=userprefs">$user <img src="/chronos_static/home.png" border=0></a></td>
<td class=top align=right><select name="object" style="background-color:black; color:white" onChange="switchobject(this.value)">
EOF
# We next print a select widget in the top right corner that lets the user
# change the object to another one. We only show objects on which the user
# has at least read access.
my $user_quoted = $dbh->quote( $self->user );
# There are two ways to have privileges on an object. An object can be
# declared public to everyone by using the public_readable and
# public_writable columns in the user table. An object can refine the
# privileges it gives to others by using the acl table, which works
# individually for each user.
my $from_user =
$dbh->selectall_arrayref(
"SELECT user, name, email FROM user WHERE user = $user_quoted OR public_readable = 'Y' OR public_writable = 'Y' ORDER BY name, user"
);
my $from_acl =
$dbh->selectall_arrayref(
"SELECT user.user, user.name, user.email FROM user, acl WHERE acl.object = user.user AND acl.user = $user_quoted AND (acl.can_read = 'Y' OR acl.can_write = 'Y')"
);
my %users = map { $_->[0] => [ $_->[1], $_->[2] ] } @$from_user, @$from_acl;
foreach (
sort { $users{$a}[0] cmp $users{$b}[0] || $a cmp $b }
keys %users
)
{
my $string =
( $users{$_}[0] || $_ )
. ( $users{$_}[1] ? " <" . $users{$_}[1] . ">" : '' );
my $selected = $self->action->object eq $_ ? 'selected' : '';
$self->{page} .= <<EOF;
<option value="$_" $selected>$string</option>
EOF
}
# Here we insert the action-specific header.
$self->{page} .= <<EOF;
</select></td>
</tr>
</table>
</td><tr><td>
<!-- Begin @{[ref $self->action]} header -->
@{[$self->action->header]}
<!-- End @{[ref $self->action]} header -->
</td></tr>
<tr>
<td>
EOF
}
# This function simply calls the Chronos::Action::content() function of the
# action. Usually an action will be derived from the top Chronos::Action class,
# so content() will be different for each action.
sub body {
my $self = shift;
$self->{page} .= <<EOF;
<!-- Begin @{[ref $self->action]} body -->
@{[$self->action->content]}
<!-- End @{[ref $self->action]} body -->
EOF
. ( $conf->{DB_HOST} ? ":$conf->{DB_HOST}" : '' )
. ( $conf->{DB_PORT} ? ":$conf->{DB_PORT}" : '' );
# Note the "RaiseError => 1". This means that any database error will cause
# an internal server error and print a message in the logs. There should be
# no error.
my $dbh =
DBI->connect( $dsn, $conf->{DB_USER}, $conf->{DB_PASS},
{ RaiseError => 1, PrintError => 0 } );
return $dbh;
}
# This function returns a hash reference containing the language-specific
# strings from a file in /usr/share/chronos/lang/...
sub gettext {
my $self = shift;
# This hash is also cached so that we scan the language file only once per
# request. Same rationale as for Chronos::conf().
if ( not $self->{text} ) {
$self->{text} = Chronos::Static::gettext( $self->lang );
}
return $self->{text};
}
# This function returns the action object based on the action the user has
# requested in its CGI query.
sub action {
my $self = shift;
my $action = shift;
my $conf = $self->conf();
# There are two ways to specify an action.
if ( my $name = $self->{r}->param('action') ) {
# Either you specify a CGI parameter named action...
$action = $name;
} elsif ( my $path_info = $self->{r}->path_info ) {
# ...or you add the wanted action to the path info. This is used for
# example in file attachment downloads, so that the browser names the
# file correctly.
($action) = $path_info =~ /^\/([^\/]+)/;
}
# The default action is configureable, so you may want Chronos to start with
# week or month view, for example.
$action ||= $conf->{DEFAULT_ACTION};
# This is a big switch statement.
if ( $action eq 'showday' ) {
return Chronos::Action::Showday->new($self);
} elsif ( $action eq 'saveevent' ) {
return Chronos::Action::SaveEvent->new($self);
} elsif ( $action eq 'editevent' ) {
return Chronos::Action::EditEvent->new($self);
} elsif ( $action eq 'showmonth' ) {
return Chronos::Action::Showmonth->new($self);
} elsif ( $action eq 'showweek' ) {
return Chronos::Action::Showweek->new($self);
} elsif ( $action eq 'edittask' ) {
return Chronos::Action::EditTask->new($self);
} elsif ( $action eq 'savetask' ) {
return Chronos::Action::SaveTask->new($self);
} elsif ( $action eq 'userprefs' ) {
return Chronos::Action::UserPrefs->new($self);
} elsif ( $action eq 'saveuserprefs' ) {
return Chronos::Action::SaveUserPrefs->new($self);
} elsif ( $action eq 'getfile' ) {
return Chronos::Action::GetFile->new($self);
} elsif ( $action eq 'delfile' ) {
return Chronos::Action::DelFile->new($self);
}
# If the $action parameter was not known, we end up here. We then call
# ourself back with the default action as the parameter, to force a return
# of the default action. A Chronos::Action object should never be used.
# Chronos::Action should be considered a pure virtual.
return $self->action($conf->{DEFAULT_ACTION});
}
# This function returns the $year,$month,$day values that should be used for
# display.
sub day {
my $self = shift;
my $year = $self->{r}->param('year');
my $month = $self->{r}->param('month');
my $day = $self->{r}->param('day');
# The defaults are today's date.
my @today = Today();
$year ||= $today[0];
$month ||= $today[1];
$day ||= $today[2];
return ( $year, $month, $day );
}
# This function is the same as Chronos::day() except that it also returns a
# $hour variable.
sub dayhour {
my $self = shift;
my ( $year, $month, $day ) = $self->day;
my $hour = $self->{r}->param('hour');
# The default hour is now's hour.
$hour = ( Now() )[0] if not defined $hour;
return ( $year, $month, $day, $hour );
}
# I don't remember writing this function. It looks like it could be used to
# build a cache of events keyed by eid, but this is a bad concept. We don't need
# a cache of events, we have the DB instead and should let it do its work. I
# don't think any action calls it.
sub event {
my $self = shift;
my $eid = shift;
$self->{events} ||= {};
if ( not $self->{events}{$eid} ) {
$self->{events}{$eid} =
$self->dbh->selectrow_hashref(
"SELECT * FROM events WHERE eventid = $eid");
}
return $self->{events}{$eid};
}
# This is a function that should go into Chronos::Action, but I'm too lazy to
# move it. It works wonderfully that way, so why bother. It returns an HTML
# string representing the minimonth box displayed at the top left corner in the
# day view and the bottom right corner in the week view.
( run in 2.449 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )