Subversion Repositories cms

<%doc>

# ---------------------------------------------------------------------- #

# Copyright: (C) 2002 Leader.IT S.r.l. <http://leader.it>     

# Authors: Guido Brugnara <gdo@leader.it>

#          Mario Claudio Pisoni <pisoni@leader.it> 

#

# $Revision: 18 $

# ---------------------------------------------------------------------- #

</%doc>

<%perl>

# ==================================== Share functions =====================================================

# ============================================================================== Uses

use POSIX ":sys_wait_h";

use Symbol;

use IO::Select;

use IPC::Open3;

use IO::File;

use DBI;

#   =============== check if two arrays has the same contents

sub sameContent($$){

  my ($ref1, $ref2) = @_;

  my $found = '';

  if ( scalar(@$ref1) != scalar(@$ref2) ){

    return($found);

  }

  foreach my $cur1 (@$ref1){

    foreach my $cur2 (@$ref2){

      if ($cur1 eq $cur2){

        $found = 'TRUE';

        last;

      }

    }

  }

  return($found);

}

# ============================================================================= writeMsg

sub writeMsg($$){

  my($message, $curfunc) = @_;

  my $LOGfile = '[[log_message_error_path]][[log_message_error_filename]]';

  if(! $MAIN::log_cms){

    `echo 'opening from run'>>[[log_message_error_path]][[log_message_error_filename]]`;

    $MAIN::log_cms = new IO::File;

    $MAIN::log_cms->open(">>$LOGfile") or die "Error opening file $LOGfile: $!";

    $MAIN::log_cms->autoflush(1);

  }

  my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

  my $time = sprintf("%04d/%02d/%02d %02d:%02d:%02d", 1900+$year, $mon+1, $mday, $hour, $min, $sec);

  print $MAIN::log_cms "$time>$curfunc:$message\n" or warn "on print file $LOGfile: $!";

#  $MAIN::log_cms->close;

}

# ============================================================================== Esecuzione

sub Esecuzione{

# Esecuzione(5, 'ls', '-l');

  my $timeout = shift;

  my $input = gensym();

  my $error = gensym();

  my $output = gensym();

  my($status, $out, $err);

  # lancio il processo

  my $pid = open3($input, $output, $error, @_);

  my $sel = new IO::Select($output,$error);

LOOP:  for(;;){

    my @ready = $sel->can_read($timeout);

    if(!@ready){

      warn "Timeout read from host";

      return (-1,$out,$err);

    }

    foreach my $h (@ready){

      my $r = <$h>;

      if($r){

        if($h eq $output){

          $out.=$r;

        }elsif($h eq $error){

          $err.=$r;

        }else{

          die "Handle $h unexpected";

        }

      }else{

        $sel->remove($h);

        if(!$sel->count()){

          last LOOP;

        }

      }

    }

  }

  if(waitpid($pid,&WNOHANG)){

    $status = ($? & 0xff00)/256;

  }else{

    $status = 0;

  }

  return ($status, $out, $err);

}

# ============================================================================== checkExec

sub checkExec($$) {

  my $caller = shift;

  my($cmd) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('100', ' 1:', '  40:', '');

  #### $s - status, $o - stdout, $r stderr

  my($s, $o, $r) = Esecuzione(8, $cmd);

  my $ret = '';

  if ($s eq '0'){           ### No errors

    chomp($o);

    $ret = 'OK_'.$o;

    $message = "in CheckExec, cmd= @_ out=$ret";

    writeMsg($message, $dbginfo . $caller. $curfunc);

  }elsif ($s eq '1'){                    ### Error

    $message = "Error on @_, status=$s, out=$o, err=$r";

    writeMsg($message, $dbgerror . $caller. $curfunc);

  }elsif ($s eq '-1'){                   ### Time out

    $message = "Time out on @_, status=$s, out=$o, err=$r";

    writeMsg($message, $dbgerror . $caller. $curfunc);

  }else{                                 ### Error Number > 1 on exit

    $message = "Error on @_, status=$s, out=$o, err=$r";

    writeMsg($message, $dbgerror . $caller. $curfunc);

  }

  return $ret;

}

sub rollbackCmd($$){

# ============================== exec all the command in the array of commands, BUT for the same argument!!!

  my ($ref_cmd, $arg) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('101', ' 1:', ' 40:', '');

  my $wasError = '';

  foreach my $curcmd (@$ref_cmd){

    my $ret=checkExec($curfunc, "su1 cms_command $curcmd $arg");

    if(! $ret ){

      $wasError .= "Incorrect in $curcmd,";

    }

  }

  return($wasError);

}

# ============================================================================== readFileIntoArray

sub readFileIntoArray($$$){

# ======= read a file, reverse if is needed and return N lines

  my ($filename, $isReverse, $cantLines) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('123', ' 1:', '   50:', 'OK');

  my $retArray;

  if (! open(FH, '<', $filename)){

   $retArray = "file:$filename, $!";

   writeMsg("cant open file:$filename:, $!", $dbgerror . $curfunc);

   return($retArray);

  }

  my $prevInputRecordSeparator = undef $/;

  $retArray = <FH>;

#   ### make a comment to turn on the ligths ' >

  $/ = $prevInputRecordSeparator;

#    $usrTraffic =~ s/\n//g;

  close FH;

  my @tmpArray = split "\n", $retArray;

  my $limit; 

  if(! $cantLines){  

    $limit = $#tmpArray;

  }else{

    $limit = $cantLines;

  }

#   ### reverse the array, Im shure there is another way to doit ;)

    my @tempA;

  if($isReverse){

    foreach my $line ( reverse @tmpArray){

      if(! $limit){

        last;

      }

      push @tempA, $line;

      $limit --;

    }

  }else{

    foreach my $line ( @tmpArray){

      if(! $limit){

        last;

      }

      push @tempA, $line;

      $limit --;

    }

  }

  $retArray = join "", @tempA;

  return($retArray);

}

# ============================================================================== Proccess form fields

sub processPOST($$) {

  my $function = shift;

  my $ref_ARGS = shift;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('122', ' 1:', '   50:', 'OK');

  my ($setfields, $setvalues) = ('','');

  my $isFirstime = 1;

  my @tmparr = [];

  my $fieldsNotProcess = '';

  foreach my $curkey (keys %$ref_ARGS){

    if($curkey =~ /_HIDE_/){

      next; ### skiping hidden field

    }

    if($curkey =~ /ROW./){

      push(@tmparr, %$ref_ARGS->{$curkey});

      next;

    }

    if($curkey =~ /FL\.(.+)/){

      if($function eq 'update'){

        if($1 =~ /_CHECK/){

#         ============== is a buton Check =====

          $setvalues = $curkey;

          next;

        }

        if($1 =~ /_SELECT/){

#         ============== is a Select Option =====

          $setvalues = $curkey;

          next;

        }

        if($isFirstime){

          $setvalues = "$1='" . %$ref_ARGS->{$curkey} ."'";

          $isFirstime = '';

          next;

        }

        $setvalues = $setvalues . ", $1='" . %$ref_ARGS->{$curkey} ."'";

      }else{

        if($isFirstime){

          $setfields .= "$1";

          $setvalues .= "'" . %$ref_ARGS->{$curkey} . "'";

          $isFirstime = '';

          next;

        }

        $setfields .= ", $1";

        $setvalues .= ", '" . %$ref_ARGS->{$curkey} . "'";

      }

    }

#  propably there are some fields that are not trated here

   $fieldsNotProcess .= "$curkey,";

  }

  if($fieldsNotProcess){

    writeMsg("fieldsNotProcess:$fieldsNotProcess:", $dbginfo . $curfunc);

  }

  if($function eq 'update'){

    return($setvalues);

  }else{

    return("($setfields) values ($setvalues)");

  }

}

# ============================================================================== ADUClassListStr

sub ADUClassListStr($$$){

  my ($function, $value, $newitemvalue) = @_;

  my $retvalue = '';

  my $found = '';

  my $firstime = 'TRUE';

  my ($newname, $newteacher, $newflag, $newcuraula, $newclasspersis) = split /:/, $newitemvalue;

  my @classes = split /\s+/, $value;

#writeMsg("value=$value", "100");

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('123', ' 1:', '  40:', '');

    # ========================== Process all the active classes, [$classid:$teacherid:$flag] ...

    foreach my $curclass ( @classes ){

      my ($name, $teacher, $flag, $curaula, $classpersis) = split /:/, $curclass;

#writeMsg("curclass=$curclass", "100");

      if( $name =~ m/$newname/ ){

        $found = 'TRUE';

        if($function eq 'ADD_FLAG' ){

          if($flag !~ m/$newflag/){

            $flag .= $newflag;

          }

          if($newteacher ne '_PREV_VALUE_'){

            $teacher = $newteacher;

          }

          $curclass = "$name:$teacher:$flag:$curaula:$classpersis";

        }elsif($function eq 'UPD_AULA'){

          $curclass = "$name:$teacher:$flag:$newcuraula:$newclasspersis";

        }elsif($function eq 'DELETE_FLAG'){

          $flag =~ s/$newflag//;

          if($newteacher ne '_PREV_VALUE_'){

            $teacher =~ s/$newteacher//;

          }

          $curclass = "$name:$teacher:$flag:$curaula:$classpersis";

        }elsif($function eq 'DELETE'){

          $curclass = '';

        }else{

          $message = "Error: function:$function unknown\n";

          writeMsg($message, $dbgerror . $curfunc);

        }

      }

      if($firstime){

        $retvalue = $curclass;

        $firstime = '';

      }else{

        $retvalue .= ' ' . $curclass;

      }

    }

    if(! $found ){

      $message = "Error: flag:$newflag didn't find on keys\n";

      writeMsg($message, $dbgerror . $curfunc);

      $retvalue = undef;

    }

    return($retvalue);

  }

# ========================================================================================

# ======================================= DB FUNCTIONS ===================================

# ========================================================================================

# ============================================================================== getDbConnect

sub getDbConnect($$){

  my ($autoCommit,$raiseError) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('102', ' 1:', '  40:', 'OK');

  if(!$autoCommit){

    $autoCommit = 1;

  }

  if(!$raiseError){

    $raiseError = 1;

  }

  my $dbh_cms = DBI->connect([[DB_StrConnect]]) or die "Cant connect dbh_cms;" . $DBI::strerr;

 DBI->trace(1, '[[log_trace_dbconnect]]');

#  DBI->trace(1);

  $dbh_cms->{RaiseError} = $raiseError;

  $dbh_cms->{AutoCommit} = $autoCommit;

  $dbh_cms->do('set DateStyle to SQL, EUROPEAN');

  return($dbh_cms);

}

# ============================================================================== getField

sub getField($$$$){

  my ($tbname, $field, $condition, $conditionvalue) = @_;

  my $dbh = getDbConnect(1,1);

  return(_getField($dbh, $tbname, $field, $condition, $conditionvalue));

}

# ============================================================================== _getField

sub _getField($$$$$){

  my ($dbh, $tbname, $field, $condition, $conditionvalue) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('103', ' 1:', '  40:', 'OK');

  my $value;

  my $curSQL = "select $field from $tbname $condition";

  my $sth = $dbh->prepare($curSQL);

  my $ret = $sth->execute($conditionvalue);

  if (! $ret){

    $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

    $value = $ret;

  }else{

    $value = $sth->fetchrow_array;

  }

  writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);

  return($value);

}

# ============================================================================== updateField1

sub updateField1($$$$$){

  my ($tbname, $field, $condition, $conditionvalue, $value) = @_;

  my $set = "$field=?";

  if($tbname eq 'keys'){

    $set = "id=nextval('keys_id'), $field=?";

  }

  return(updateField($tbname, $set, $condition, $conditionvalue, $value));

}

# ============================================================================== updateField

sub updateField($$$$$){

  my ($tbname, $set, $condition, $conditionvalue, $value) = @_;

  my $dbh = getDbConnect(1,1);

  return(_updateField($dbh, $tbname, $set, $condition, $conditionvalue, $value));

}

# ============================================================================== _updateField1

sub _updateField($$$$$$){

  my ($dbh, $tbname, $set, $condition, $conditionvalue, $value) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('104', ' 1:', '  40:', 'OK');

  my $curSQL = "update $tbname set $set $condition";

  my $sth = $dbh->prepare($curSQL);

  my $ret = $sth->execute($value, $conditionvalue);

  if ($ret eq "0E0"){

    $message = "error ret:$ret:, on $curSQL ($value, $conditionvalue); errstr:" . $dbh->errstr;

    $ret = 0;

  }

  writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);

  return($ret);

}

# ============================================================================== insertRecord

sub insertRecord($$){

  my ($tbname, $condition) = @_;

  my $dbh = getDbConnect(1,1);

  return(_insertRecord($dbh, $tbname, $condition));

}

# ============================================================================== insertRecord

sub _insertRecord($$$){

  my ($dbh, $tbname, $condition) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('105', ' 1:', '  40:', 'OK');

  my $curSQL = "insert into $tbname $condition";

  my $sth = $dbh->prepare($curSQL);

  my $ret = $sth->execute();

  if (! $ret){

    $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

  }

  writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);

  return($ret);

}

# ============================================================================== deleteRecord

sub deleteRecord($$$){

  my ($tbname, $condition, $conditionvalue) = @_;

  my $dbh = getDbConnect(1,1);

  return(_deleteRecord($dbh, $tbname, $condition, $conditionvalue));

}

# ============================================================================== deleteRecord

sub _deleteRecord($$$$){

  my ($dbh, $tbname, $condition, $conditionvalue) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('106', ' 1:', '  40:', 'OK');

  my $curSQL = "delete from $tbname $condition";

  my $sth = $dbh->prepare($curSQL);

  my $ret = $sth->execute($conditionvalue);

  if (! $ret){

    $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

  }

  writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);

  return($ret);

}

# ============================================================================== modifyFieldDataFunction

sub modifyFieldDataFunction($$$){

  my ($value, $function, $functionargs) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('34b', '    1:', '   40:', '');

  my $newvalue;

#writeMsg("MAPI fargs=$functionargs=", $dbginfo . $curfunc);

#writeMsg("MAPI value=$value=", $dbginfo . $curfunc);

  if($function eq 'deleteClass'){

    my $classid = $functionargs;

    $newvalue =  ADUClassListStr('DELETE', $value, "$classid:_PREV_VALUE_:_PREV_VALUE:_PREV_VALUE_:_PREV_VALUE");

  }elsif($function eq 'insertVipUsr'){

    my $usrid = $functionargs;

    $newvalue = $value;

    if($value !~ m/$usrid/){

      $newvalue = $value . " $usrid";

    }

  }elsif($function eq 'deleteVipUsr'){

    my $usrid = $functionargs;

    $newvalue = $value;

    if($value =~ m/$usrid/){

      $newvalue =~ s/$usrid//;

    }

  }elsif($function eq 'deleteFM'){

    my $fm = $functionargs;

    $newvalue = $value;

    if($value =~ m/$fm/){

      $newvalue =~ s/\s*$fm//;

    }

  }elsif($function eq 'insertFM'){

    chomp($value);

    $newvalue = $value . "$functionargs";

  }elsif($function eq 'insertClass'){

    chomp($value);

    my $tmpargs = $functionargs;

    if($functionargs =~ m/_BLANK_/){

      $tmpargs =~ s/_BLANK_//;

#writeMsg("MAPI tmpargs=$tmpargs=", $dbginfo . $curfunc);

    }

    $newvalue = $value . " $tmpargs";

  }elsif($function eq 'updateClass'){

    $newvalue = $value . " $functionargs";

  }elsif($function eq 'updateClassAula'){

    my ($classid, $status, $newflag, $curaula, $classpersis) = split /:/, $functionargs;

    if($classpersis =~ m/_BLANK_/){

      $classpersis =~ s/_BLANK_//;

    }

    $newvalue =  ADUClassListStr('UPD_AULA', $value, "$classid:_PREV_VALUE_:_PREV_VALUE_:$curaula:$classpersis");

  }elsif($function eq 'updateClassFlag'){

    my ($classid, $status, $newflag, $curaula, $classpersis) = split /:/, $functionargs;

#$m->out(Dumper($functionargs));

    if($status =~ m/[[class_status_active]]/ ){

      $newvalue =  ADUClassListStr('ADD_FLAG', $value, "$classid:_PREV_VALUE_:$newflag:_PREV_VALUE_:_PREV_VALUE");

    }else{

      $newvalue =  ADUClassListStr('DELETE_FLAG', $value, "$classid:_PREV_VALUE_:$newflag:_PREV_VALUE_:_PREV_VALUE");

    }

# =========== used by class ==========

  }elsif($function eq 'OFF'){

    $newvalue = $value;

    if($value =~ m/$functionargs/){

      $newvalue =~ s/$functionargs//;

    }

  }elsif($function eq 'ON'){

    $newvalue = $value . "$functionargs";

  }else{

    writeMsg("Error:rich case default on $function", $dbgerror . $curfunc);

  }

  return($newvalue);

}

# ============================================================================== updateDbField

sub modifyFieldData($$$$$$){

  my ($tablename, $field, $condition, $conditionvalue, $function, $functionargs) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('34b', '    1:', '  40:', '');

  my $dbh = getDbConnect(1,1);

#  ===================================================================== Begin Transaction

  $dbh->begin_work  or writeMsg("cant begin trans".$dbh->errstr, $dbgerror . $curfunc);

  my $ret = _modifyFieldData($dbh, $tablename, $field, $condition, $conditionvalue, $function, $functionargs);

  if(! $dbh->commit){

    $dbh->rollback or writeMsg("cant commit".$dbh->errstr, $dbgerror . $curfunc);

    writeMsg("Cant commit ".$dbh->errstr, $dbgerror . $curfunc);

  }else{

    writeMsg("OK", $dbginfo . $curfunc);

  }

  return($ret);

}

# ============================================================================== updateDbField

sub _modifyFieldData($$$$$$$){

  my ($dbh, $tablename, $field, $condition, $conditionvalue, $function, $functionargs) = @_;

  my ($sth, $ret, $curSQL);

  my ($key, $value, $newvalue);

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('34', '    1:', '  40:', '');

  # ==================================================== Get the value to update

  $curSQL = "select $field from $tablename $condition";

  $sth = $dbh->prepare($curSQL);

  $ret = $sth->execute($conditionvalue);

  if (! $ret){

    $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

    writeMsg($message, $dbgerror . $curfunc);

  }

  $value = $sth->fetchrow_array;

  # ==================================================== Process the value with function

  $newvalue = modifyFieldDataFunction($value, $function, $functionargs);

  if($newvalue eq undef){

    return(0);

  }

# ==================================================== Process the value with function

  if($tablename eq 'keys'){

    $curSQL = "update $tablename set id=nextval('keys_id'), $field=? $condition";

  }else{

    $curSQL = "update $tablename set $field=? $condition";

  }

#$m->out( $curSQL);

  $sth = $dbh->prepare($curSQL);

  $ret = $sth->execute($newvalue, $conditionvalue);

  if (! $ret){

    $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

    writeMsg($message, $dbgerror . $curfunc);

  }

  return($ret);

}

# ============================================================================== getUsrConnectInfo

sub getUsrConnectInfo($){

  my ($field) = @_;

  my $dbh = getDbConnect(1,1);

  return(_getUsrConnectInfo($dbh, $field));

}

# ============================================================================== getUsrConnectInfo

sub _getUsrConnectInfo($$){

  my ($dbh, $field) = @_;

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('107', ' 1:', ' 40:', 'OK');

  my ($ret, $remoteIp);

  if(%ENV->{'HTTP_X_FORWARDED_FOR'}){

    $remoteIp= %ENV->{'HTTP_X_FORWARDED_FOR'};

  }else{

    $remoteIp= %ENV->{'REMOTE_ADDR'};

  }

  if($field eq 'profile'){

    my $sth = $dbh->prepare_cached(<<SQL);

select profile from usr, classlayout where classlayout.usrid = usr.id and classlayout.pcip=?

SQL

#    my $profile;

#    $sth->bind_columns(undef, \$profile);

    $sth->execute($remoteIp);

#    $sth->fetch;

#    $ret = $profile;

    ($ret) = $sth->fetchrow_array;

  }else{

    my $cmd   = " select $field";

    my $from  = ' from usr, classlayout';

    my $where = ' where classlayout.usrid = usr.id and classlayout.pcip=?';

    my $curSQL = $cmd . $from . $where;

    my $sth = $dbh->prepare($curSQL);

    if(! $sth->execute($remoteIp) ){

      $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

      writeMsg($message, (($ret)? $dbginfo:$dbgerror) . $curfunc);

    }

    ($ret) = $sth->fetchrow_array;

  }

  return($ret);

}

# ============================================================================== getEnableStudentOfClass

sub getStudentOfClass($$){

  my ($classid, $reason) = @_;

  my $dbh = getDbConnect(1,1);

  return(_getStudentOfClass($dbh, $classid, $reason));

}

# ============================================================================== getEnableStudentOfClass

sub _getStudentOfClass($$$){

  my ($dbh, $classid, $reason) = @_;

  my ($sth, $ret, $curSQL);

  my ($curfunc,$dbgerror,$dbginfo,$message)  = ('36', ' 1:', '  40:', 'OK');

  if($reason eq '4share'){

    $curSQL = "select usrid from usrclass, usr where classid='$classid' and usrclass.profile='[[usr_profile_student]]' and usrclass.permision like '%[[usr_permision_SH]]%' and usrid=usr.id and usr.profile='[[usr_profile_student]]'";

  }elsif($reason eq '4web'){

    $curSQL = "select usrid from usrclass where classid='$classid' and profile='[[usr_profile_student]]' and permision like '%[[usr_permision_WW]]%' ";

  }elsif($reason eq '4all'){

    $curSQL = "select usrid from usrclass where classid='$classid' and profile='[[usr_profile_student]]'";

  }else{

    writeMsg("in Otherwise :$reason:", $dbgerror . $curfunc);

  }

  my $ref_usrid = $dbh->selectall_arrayref($curSQL);

  if (! $ref_usrid){

    my $message = "error, on $curSQL\n; errstr:" . $dbh->errstr;

    writeMsg($message, $curfunc);

  }else{

    writeMsg("OK", $dbginfo . $curfunc);

  }

  my $listusr = '';

  foreach my $curusr ( @$ref_usrid ){

    $listusr .= ' ' . $curusr->[0];

  }

  return($listusr);

}

# ==================================== End Share functions =================================================

</%perl>

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">

<html>

<head>

  <META HTTP-EQUIV="content-type" CONTENT="text/html; charset=ISO-8859-15">

  <META HTTP-EQUIV="Expires" CONTENT="now">

  <title>

<& SELF:title &>

  </title>

  <link rel="stylesheet" href="/cms/include/styles.css?Rel=001" type="text/css">

</head>

%# <BODY BGCOLOR="<% $color %>">

<% $m->call_next %>

<& .footer &>

<%method title>

  CMS (Classroom Management System) by Leader.IT S.r.l.

</%method>

<%init>

 my $color = "#f1edd3";

 $r->headers_out->add('Expires' => 'now');

 $r->headers_out->add('Content-Language' => 'it_IT'); 

</%init>