/tags/v2-75/mh/code/common/trigger_code.pl

# Category = MisterHouse

#@ Monitors trigger code, used by code like tv_grid and the web alarm page,
#@ that specifies events that trigger actions.  View, add, modify, or
#@ delete triggers with <a href=/bin/triggers.pl>/bin/triggers.pl</a>.

use vars '%triggers';           # use vars so we can use in the web server

my ($trigger_write_code_flag, $prev_triggers, $prev_script);
my $trigger_file = "$config_parms{data_dir}/triggers.current";
my $expired_file = "$config_parms{data_dir}/triggers.expired";
my $script_file  = "$config_parms{code_dir}/triggers.mhp";

                                # No need to save right after startup 
$prev_triggers = &file_read($trigger_file) if $Reload and -e $trigger_file;
$prev_script   = &file_read($script_file)  if $Reload and -e $script_file;

&Exit_add_hook(\&triggers_save) if $Reload;
&triggers_save      if new_minute 5;
&triggers_read      if $Startup;
&trigger_write_code if $trigger_write_code_flag;


# Read current triggers file at startup
sub triggers_read {
                                # Read trigger data
    return unless -e $trigger_file;

    my $i = 0;
    undef %triggers;

    my ($trigger, $code, $name, $type, $triggered);
    for my $record (&file_read($trigger_file), '') {
        if ($record =~ /\S/) {
            next if $record =~ /^ *#/;
            if ($record =~ /^name=(.+?)\s+type=(\S+)\s+triggered=(\d*)/) {
                $name = $1;  $type = $2; $triggered = $3;
            }
            elsif (!$trigger) {
                $trigger = $record;;
            }
            else {
                next if $record =~ /^\d+ \d+$/;  # Old trigger format ... ignore
                $code .= $record . "\n";
            }
        }
                          # Assume there is always a blank line at end of file
        elsif ($trigger) {
            trigger_set($trigger, $code, $type, $name, 1, $triggered);
            $trigger = $code = $name = $type = $triggered = '';
            $i++;
        }
    }
    print_log "Read $i trigger entries";
}

                                # Write trigger code
sub trigger_write_code {
    $trigger_write_code_flag = 0;
    my $script;
    foreach my $name (trigger_list()) {
        my ($trigger, $code, $type, $triggered) = trigger_get($name);
        
        $script .= "\n# name=$name type=$type\n";
        $script .= "if (($trigger) and &trigger_active('$name')) {\n";
        $script .= "    &trigger_expire('$name');\n";
        $script .= "    $code;\n}\n";
    }
    $script = "#\n#@ Do NOT edit.  This file is auto-generated by mh/code/common/trigger_code.pl\n" . 
              "#@ and reflects the data in data_dir/triggers.current\n#\n" . $script;
    return if $script eq $prev_script; 
    $prev_script = $script; 
    &file_write($script_file, $script);
                                # Replace (faster) or reload (if there was no file previously)
    if ($Run_Members{'triggers_table'}) {
        &do_user_file("$config_parms{code_dir}/triggers.mhp");
    }
    else {
                                # Must be done before the user code eval
        push @Nextpass_Actions, \&read_code;
    }

}

                                # Save and prune out expired triggers
sub triggers_save {
    my ($data, $data1, $data2, $i1, $i2);
    $i1 = $i2 = 0;
    $data1 = $data2 = '';
    foreach my $name (trigger_list()) {
        my ($trigger, $code, $type, $triggered) = trigger_get($name);
        $data  = "name=$name type=$type triggered=$triggered\n";
        $data .=  $trigger . "\n";
        $data .=  $code . ";\n";
                                # Prune it out if it is expired and > 1 week old
        if (trigger_expired($name) and ($triggers{$name}{triggered} + 60*60*24*7) < $Time) {
            $data2 .= $data . "\n";
            $i2++;
            delete $triggers{$name};
        }
        else {
            $data1 .= $data . "\n";
            $i1++;
        }
    }
    print_log "Saving triggers:  $i2 expired, $i1 saved" if $i2;
    $data1 = '#
# Note: Do NOT edit this file while mh is running (edits will be lost).
# It is used by mh/code/common/trigger_code.pl to auto-generate code_dir/triggers.mhp.
# It is updated by various trigger_ functions like trigger_set.
# Syntax is:
#   name=trigger name  type=trigger_type  triggered=triggered_time
#   trigger_clause
#     code_to_run
#     code_to_run
#
# Expired triggers will be pruned to triggers.expired a week after they expire.
#

' . $data1;
    $data2 = "# Expired on $Time_Date\n" . $data2 if $data2;
    unless ($data1 eq $prev_triggers) {
        &file_write($trigger_file, $data1);
        &logit($expired_file, $data2, 0) if $data2;
        $trigger_write_code_flag++;
    }
    $prev_triggers = $data1; 
    return;
}

sub trigger_set {
    my ($trigger, $code, $type, $name, $replace, $triggered) = @_;

    print "trigger: trigger=$trigger code=$code name=$name\n" if $config_parms{debug} eq 'trigger';
    return unless $trigger and $code; 

                                # Find a uniq name    
    if ($triggers{$name} and $replace) {
        print_log "trigger $name already exists, modifying";
    }
    else {
        $name = time_date_stamp(12) unless $name;
        if ($triggers{$name}) {
            my $i = 2;
            while ($triggers{"$name $i"}) { $i++; }
            $name = "$name $i";
        }
    }

    $code =~ s/;?\n?$//;  # So we can consistenly add ;\n when used
    $triggered = 0 unless $triggered;
    $type  = 'OneShot' unless $type;
    $triggers{$name}{trigger} = $trigger; 
    $triggers{$name}{code}    = $code; 
    $triggers{$name}{triggered} = $triggered;
    $triggers{$name}{type}  = $type;
    $trigger_write_code_flag++;
    return;
}

sub trigger_get {
    my $name = shift;
    return $triggers{$name}{trigger}, $triggers{$name}{code}, $triggers{$name}{type}, $triggers{$name}{triggered};
}

sub trigger_delete {
    my $name = shift;
    delete $triggers{$name};
    $trigger_write_code_flag++;
    return;
}

sub trigger_copy {
    my $name = shift;
    my $name2 = "$name 2";
    if (my ($r, $i) = $name =~ /(.+) (\d+)$/) {
        $name2 = "$r " . ++$i;
    }
    $triggers{$name2}{trigger}   = $triggers{$name}{trigger};
    $triggers{$name2}{code}      = $triggers{$name}{code};
    $triggers{$name2}{type}      = $triggers{$name}{type};
    $triggers{$name2}{triggered} = 0;
    return;
}

sub trigger_rename {
    my ($name1, $name2) = @_;
    $triggers{$name2}{trigger}   = $triggers{$name1}{trigger};
    $triggers{$name2}{code}      = $triggers{$name1}{code};
    $triggers{$name2}{type}      = $triggers{$name1}{type};
    $triggers{$name2}{triggered} = $triggers{$name1}{triggered};
    delete $triggers{$name1};
    $trigger_write_code_flag++;
    return;
}

sub trigger_list {
    return sort keys %triggers;
}

sub trigger_active {
    my $name = shift;
#   print "db n=$name t=$triggers{$name}{type} e=!$triggers{$name}{triggered}\n";
    return ($triggers{$name}{type} eq 'NoExpire' or $triggers{$name}{type} eq 'OneShot');
}

sub trigger_expired {
    my $name = shift; 
    return ($triggers{$name}{type} eq 'Expired');
}

sub trigger_expire {
    my $name = shift; 
    $triggers{$name}{triggered} = $Time;
    return unless $triggers{$name}{type} eq 'OneShot';
#   print "db setting name=$name expire_time=$Time\n";
    $triggers{$name}{type}      = 'Expired';
    return;
}

# $Included_HTML{MisterHouse} = '<!--#include code="&trigger_html"-->'  if $Reload;