view release on metacpan or  search on metacpan

example/lava_lamp.pl  view on Meta::CPAN

It also tries to check that:

=over

=item * 

The lamp can be switched on only during certain time periods

=item *

The lamp doesn't run longer than a maximum time (e.g. 6 hours) 
(C<$LAMP_MAX_TIME>)

=item *

That the lamp is not switched on again after being switched off within a
certain time period (C<$LAMP_REST_TIME>)

=item *

That manual switches are detected and recorded

=back

This script knows three modes:

=over

=item watch

The "watch" mode is used for ensuring that the lamp is not switched on for
certain time i.e. during the night. The Variable C<$LAMP_ON_TIME_TABLE> can be
used to customize the time ranges on a weekday basis. 

=item notify

The "notify" mode is used by a notification handler, e.g. from Nagios or from
Jenkins. In this mode, the C<type> parameter is used for signaling whether the
lamp should be switched on ("problem") or off ("recovery").

=item list

This scripts logs all activities in a log file C<$LOG_FILE>. With the "list"
mode, all history entries can be viewed. 

=back

=cut

# ===========================================================================
# Configuration section

# Configuration required for accessing the switch. 
my $SWITCH_CONFIG = 
    {
     # AVM AHA Host for controlling the devices 
     host => "fritz.box",
     
     # AVM AHA Password for connecting to the $AHA_HOST     
     password => "s!cr!t",
     
     # AVM AHA user role (undef if no roles are in use)
     user => undef,
     
     # Name of AVM AHA switch
     id => "Lava Lamp"
    };

# Time how long the lamp should be at least be kept switched off (seconds)
my $LAMP_REST_TIME = 60 * 60;

# Maximum time a lamp can be on 
my $LAMP_MAX_TIME = 5 * 60 * 60; # 5 hours

# When the lamp can be switched on. The values can contain multiple time
# windows defined as arrays
my $LAMP_ON_TIME_TABLE = 
    {
     "Sun" => [ ["7:55",  "23:00"] ],
     "Mon" => [ ["6:55",  "23:00"] ],
     "Tue" => [ ["13:55", "23:00"] ],
     "Wed" => [ ["13:55", "23:00"] ],
     "Thu" => [ ["13:55", "23:00"] ],
     "Fri" => [ ["6:55",  "23:00"] ],
     "Sat" => [ ["7:55",  "23:00"] ],     
    };

# File holding the lamp's status
my $STATUS_FILE = "/var/run/lamp.status";

# Log file where to log to 
my $LOG_FILE = "/var/log/lamp.log";

# Stop file, when, if exists, keeps the lamp off
my $OFF_FILE = "/tmp/lamp_off";

# Time back in passed assumed when switching was done manually (seconds)
# I.e. if a manual state change is detected, it is assumed that it was back 
# that amount of seconds in the past (5 minutes here)
my $MANUAL_DELTA = 5 * 60;

# Maximum number of history entries to store
my $MAX_HISTORY_ENTRIES = 1000;

# ============================================================================
# End of configuration

use Storable qw(fd_retrieve store_fd store retrieve);
use Data::Dumper;
use feature qw(say);
use Fcntl qw(:flock);
use Getopt::Long;
use strict;

my %opts = ();
GetOptions(\%opts, 'type=s','mode=s','debug!','name=s','label=s','config=s');

my $DEBUG = $opts{debug};
read_config_file($opts{config}) if $opts{config};
init_status();

example/lava_lamp.pl  view on Meta::CPAN

    delete $status->{trigger_mark};
    delete $status->{trigger_label};
}

sub set_trigger {
    my $status = shift;
    my $label = shift;
    $status->{trigger_mark} = 1;
    $status->{trigger_label} = $label;
}

sub has_trigger {
    return shift->{trigger_mark};
}

sub trigger_label {
    return shift->{trigger_label};
}

# ====================================================
# Status file handling including locking

my $status_fh;

sub fetch_status {
    open ($status_fh,"+<$STATUS_FILE") || die "Cannot open $STATUS_FILE: $!";
    $status = fd_retrieve($status_fh) || die "Cannot read $STATUS_FILE: $!";
    flock($status_fh,2);
    return $status;
}


sub store_status {
    my $status = shift;
    
    # Truncate history if necessary
    truncate_hist($status);
    # Store status and unlock
    seek($status_fh, 0, 0); truncate($status_fh, 0);
    store_fd $status,$status_fh;
    close $status_fh;    
}

sub truncate_hist {
    my $status = shift;

    my $hist = $status->{hist};
    my $len = scalar(@$hist);
    splice @$hist,0,$len - $MAX_HISTORY_ENTRIES if $len > $MAX_HISTORY_ENTRIES;
    $status->{hist} = $hist;
}

# ==========================================================================
# Customize the following call and class in order to use a different 
# switch than AVM AHA's
sub open_lamp {
    my $config = shift;
    my $name = shift || $config->{id};
    return new Lamp($name,
                    $config->{host},
                    $config->{password},
                    $config->{user});
}

sub close_lamp {
    my $lamp = shift;
    $lamp->logout();
}

package Lamp;

use AHA;

sub new { 
    my $class = shift;
    my $name = shift;
    my $host = shift;
    my $password = shift;
    my $user = shift;

    my $aha = new AHA($host,$password,$user);
    my $switch = new AHA::Switch($aha,$name);
    
    my $self = {
                aha => $aha,
                switch => $switch
               };
    return bless $self,$class;
}

sub is_on {
    shift->{switch}->is_on();
}

sub on { 
    shift->{switch}->on();
}

sub off { 
    shift->{switch}->off();
}

sub logout {
    shift->{aha}->logout();
}

=head1 LICENSE

lava_lampl.pl is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.

lava_lamp.pl is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with lava_lamp.pl.  If not, see <http://www.gnu.org/licenses/>.

=head1 AUTHOR

roland@cpan.org

=cut