jsw/signcontrol
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Init

Browse source
This commit is contained in:
Jurn Wubben 2025-08-05 13:55:52 +02:00
commit 94fb8b3c7b
10 changed files with 986 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

1
.envrc Normal file
View file

@ -0,0 +1 @@
use flake

22
.gitignore vendored Normal file
View file

@ -0,0 +1,22 @@
*.bak
*.old
*.tmp
*.tar.gz
*.rej
*.orig
*~
/Build
/Build.bat
/Makefile
/_build
/blib
/cover_db
/pm_to_blib
/PM_to_blib
/META.*
/MYMETA.*
/*.tar.gz
*/Module-Build-*
/LICENSE
/README
.direnv

10
Build.PL Normal file
View file

@ -0,0 +1,10 @@
use Module::Build;
Module::Build->new(
module_name => 'Net::Symon::NetBrite',
license => 'perl',
requires => {
perl => '5.6.1',
'Digest::CRC' => '0.18',
'IO::Socket::INET' => '1.31',
},
)->create_build_script();

15
Makefile.PL Normal file
View file

@ -0,0 +1,15 @@
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'SignControl',
VERSION => '1.0',
EXE_FILES => ['signcontrol'],
PREREQ_PM => {
perl => '5.6.1',
'Digest::CRC' => '0.18',
'IO::Socket::INET' => '1.31',
},
INSTALLDIRS => 'site',
);

120
README.md Normal file
View file

@ -0,0 +1,120 @@
# SignControl
## Introduction
SignControl is a cli utility that controls Symon NetBrite LED signs. Huge thanks
to [kevinbosak](https://github.com/kevinbosak/Net-Symon-Netbrite).
## Installation Instructions
1. **Set Up Network:** Ensure your device is on the same subnet as the sign. For
example, add an IP address to your Ethernet interface:
```sh
sudo ip addr add 10.164.3.86/24 dev enp0s25 # Replace with your interface
name (e.g., enp0s25)
```
This configures your device to communicate with the sign.
2. **Install Perl Dependencies:** On a Debian-based system, install the required
packages:
```sh
sudo apt install libmodule-build-perl libdigest-crc-perl
```
3. **Build and Install the Module:**
```sh
perl Build.PL ./Build installdeps # Installs any additional dependencies
./Build manifest # Generates the MANIFEST file
```
These steps prepare the module for use. If you're building from source,
ensure you have Perl 5.10 or later.
## Usage
To send messages to the sign, edit and run the provided script (e.g.,
`signboard`). Example:
```
signboard --address 10.164.3.87 --zone zone1="x=0,y=0,width=20,height=5" --zone
zone2="x=10,y=10,width=10,height=10" --message zone1="Hello {scrolloff}"
--message zone2="World {red}"
```
- Replace `10.164.3.87` with your sign's IP address.
- Define zones with `--zone zonename="x=0,y=0,width=20,height=5"`.
- Provide messages with `--message zonename="Text with formatting"`.
- Options like `--priority override` or `--ttl 60` control message behavior.
- I reccommend adding `{erase}` to the beginning of your first message. This
will prevent glitches when changing the text.
## Message Formatting
Messages support inline markup for dynamic effects. Include these tags directly
in your message text:
- **Scrolling:** `{scrolloff}` (turns off), `{scrollon}` (turns on).
- **Blinking:** `{blinkon}` (turns on), `{blinkoff}` (turns off).
- **Color:** `{red}`, `{green}`, `{yellow}`.
- **Alignment:** `{left}`, `{center}`, `{right}`.
- **Pause:** `{pause}` (pauses display).
- **Erase:** `{erase}` (clears content).
- **Serial Number:** `{serial}` (inserts sign's MAC address).
- **Beep:** `{bell}` (It _should_ beep, but when I tried it it paused the text
at the end).
- **Note:** `{note [pitch] [duration]}` (e.g., `{note 100 500}` for a 100 Hz
tone lasting 500 ms).
- **Tune:** `{tune [1-9] ["repeat"]}` (e.g., `{tune 9}` for Charge!; add
"repeat" for looping).
- **Font:** `{font [font_name]}` (switches font; see below).
## Available Fonts
The following fonts can be used with `{font [font_name]}`:
- monospace_7
- monospace_16
- monospace_24
- proportional_7
- proportional_5
- proportional_9
- proportional_11
- bold_proportional_7
- bold_proportional_11
- script_16
- picture_24
Note: Ensure the font fits within the zone's height to avoid issues.
## Zone Parameters
To create a zone, add the `--zone` flag with the parameters in the following
format:
```
--zone name="param1=0,param2=0"
```
- **x:**: The X coordinate to start the zone, required.
- **y:**: The Y coordinate to start the zone, required.
- **width:**: The zone width, required.
- **height:**: The zone height, required.
- **scroll_speed:** The speed of scrolling text in the zone. The default is
`SCROLL_MED`, but can also be `SCROLL_SLOW` or `SCROLL_FAST`.
- **pause_duration:** The duration in milliseconds of any pause sequences in the
message text.
- **volume:** The volume of beeps, notes, alarms, and other noises. Valid range
is 0 (off) to 8 (deadly). Default is 4.
- **default_font:** The default font. See 'Available Fonts'
- **default_color:** The default color. Can be `COLOR_RED`, `COLOR_GREEN`, or
`COLOR_YELLOW`. The default is red.
- **initial_text:** The text initially displayed in the zone. This is just "."
by default.

26
flake.lock generated Normal file
View file

@ -0,0 +1,26 @@
{
"nodes": {
"nixpkgs": {
"locked": {
"lastModified": 1754381359,
"narHash": "sha256-fXmfK4eoA8hUqmEBWFlndH90Zc7vPjqDct+sjLXtCM8=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "98b601302da9859b201bd858a8949aafec80ead1",
"type": "github"
},
"original": {
"owner": "NixOS",
"repo": "nixpkgs",
"type": "github"
}
},
"root": {
"inputs": {
"nixpkgs": "nixpkgs"
}
}
},
"root": "root",
"version": 7
}

40
flake.nix Normal file
View file

@ -0,0 +1,40 @@
{
inputs.nixpkgs.url = "github:NixOS/nixpkgs";
outputs = {
self,
nixpkgs,
...
}: let
system = "x86_64-linux";
pkgs = nixpkgs.legacyPackages.${system};
in {
packages.${system}.default = let
pP = pkgs.perlPackages;
in
pkgs.perlPackages.buildPerlPackage rec {
pname = "SignControl";
version = "0.1";
src = ./.;
propagatedBuildInputs = [pP.DigestCRC pP.ModuleBuild];
nativeBuildInputs = [pkgs.shortenPerlShebang];
postInstall = ''
shortenPerlShebang $out/bin/signcontrol
'';
};
devShells.${system}.default =
pkgs.mkShell
{
nativeBuildInputs = [
(pkgs.perl.withPackages
(x: [
x.DigestCRC
x.ModuleBuild
]))
];
};
};
}

537
lib/Net/Symon/NetBrite.pm Normal file
View file

@ -0,0 +1,537 @@
package Net::Symon::NetBrite;
our $VERSION = '0.01';
=head1 NAME
Net::Symon::NetBrite - Talk to Symon NetBrite LED signs
=head1 SYNOPSIS
use Net::Symon::NetBrite qw(:constants);
use Net::Symon::NetBrite::Zone;
my $sign = new Net::Symon::NetBrite(
address => '192.168.34.56',
);
my $zone = new Net::Symon::NetBrite::Zone(
rect => [0, 0, 200, 24],
default_font => 'monospace_16',
);
$sign->zones(
myzone => $zone,
);
$sign->message('myzone', '{green}west philadelphia {red}born and raised');
$sign->reboot();
=head1 DESCRIPTION
Do you have a bunch of Symon NetBrite II signs laying around from a
company you acquired that had more money than sense? So do we!
=cut
use IO::Socket::INET;
use Digest::CRC;
use Carp;
require Exporter;
use constant {
COLOR_RED => 0x01,
COLOR_GREEN => 0x02,
COLOR_YELLOW => 0x03,
SCROLL_SLOW => 0x01,
SCROLL_MED => 0x02,
SCROLL_FAST => 0x03,
PRI_OVERRIDE => 0x01,
PRI_INTERRUPT => 0x02,
PRI_FOLLOW => 0x03,
PRI_YIELD => 0x04,
PRI_ROUNDROBIN => 0x0a,
};
our %fonts = (
monospace_16 => 0x00,
proportional_7 => 0x01,
proportional_5 => 0x02,
proportional_11 => 0x03,
monospace_24 => 0x04,
bold_proportional_7 => 0x05,
bold_proportional_11 => 0x06,
monospace_7 => 0x07,
script_16 => 0x08,
proportional_9 => 0x09,
picture_24 => 0x0a,
);
our @ISA = qw(Exporter);
my @consts = qw( COLOR_RED COLOR_GREEN COLOR_YELLOW
SCROLL_SLOW SCROLL_MED SCROLL_FAST
PRI_OVERRIDE PRI_INTERRUPT PRI_FOLLOW PRI_YIELD PRI_ROUNDROBIN);
our @EXPORT_OK = @consts;
our %EXPORT_TAGS = ( constants => \@consts );
=head1 METHODS
=head2 new()
Creates a new instance, which handles a single sign. The following
parameters are accepted:
=over
=item address
The address of the sign.
=item port
(optional) The destination port. Defaults to 700.
=item callback
If supplied, no socket will be created. Instead, the supplied coderef
will be called with a single argument whenever data needs to be sent.
This is intended for use with an external framework like L<POE|POE>.
=back
=cut
sub new {
my ($class, %data) = @_;
my $self = {};
if ($data{callback}) {
$self->{callback} = $data{callback};
} elsif ($data{address}) {
$self->{addr} = $data{address};
$self->{port} = $data{port} || 700;
} else {
croak 'Either address or callback must be supplied';
}
$self->{seqno} = 0;
$self->{sessno} = 0;
bless($self, $class);
return $self;
}
sub pkt_escape {
my $pkt = shift;
my $esc = pack('C', 0x10);
my $buf;
for (my $i = 0; $i < length $pkt; $i++) {
my $byte = unpack("x[$i]C", $pkt);
if ($i > 4 && $i < length($pkt) - 4 && ($byte == 0x10 || $byte == 0x01 || $byte == 0x04 || $byte == 0x17)) {
$buf .= $esc;
}
$buf .= pack('C', $byte);
}
return $buf;
}
sub crc { return Digest::CRC::crc(shift, 16, 0x0000, 0x0000, 1, 0x1021, 1, 0) }
sub tx {
my ($self, $pkt) = @_;
if (defined $self->{callback}) {
$self->{callback}->($pkt);
} else {
$self->{sock}->send($pkt);
$self->{sock}->flush();
}
}
sub connect {
my $self = shift;
$self->{sock} = IO::Socket::INET->new(
PeerAddr => $self->{addr},
PeerPort => 700,
Proto => 'tcp',
);
unless (defined $self->{sock}) {
croak "Socket: $!";
}
$self->{sessno} = 0;
#$self->zones();
}
=head2 zones()
Updates the list of zones associated with the sign. Any existing
zones are replaced. The zones will be sent to the sign immediately
and upon every successful reconnection.
The only parameter is a hash, in which the keys are zone names and the
values are L<Net::Symon::NetBrite::Zone|Net::Symon::NetBrite::Zone>
objects.
If called without a list of zones, the last provided zones will be
sent to the sign again.
=cut
sub zones {
my ($self, %zones) = @_;
if (%zones) {
$self->{zones} = \%zones;
} elsif (!defined $self->{zones}) {
return undef;
}
if (!defined $self->{sock}) {
$self->connect();
}
my $zid = 1;
foreach my $zname (sort { $a cmp $b } keys %{$self->{zones}}) {
my $z = $self->{zones}->{$zname};
$z->id($zid);
my $ztext = &parse_msg($z->get('initial_text'));
my $zlen = length $ztext;
my $body = pack("C4 CC4 C3 Cv C8 C C4 C4 vC5 C10 C3 C20vC3C11A[$zlen] C",
0x0f, 0x00, 0x0e, 0x02, # body start
$zid, @{$z->get('rect')}, # zone def
0x0d, $z->get('scroll_speed'), 0x00, # scroll rate
0x0c, $z->get('pause_duration'), # pause duration
0x0b, 0xfe, 0x0a, 0xe8, 0x03, 0x09, 0x0e, 0x08, # msg def params
$z->get('volume'), # volume (0-8)
0x07, $fonts{$z->get('default_font')}, 0x06, $z->get('default_color'), # default font
0x05, 0x00, 0x00, 0x04, # font footer
2012, 2, 10, 19, 21, 33, # timestamp: yyyy, mo, d, h, min, sec?
# tfmt
0x00, 0x03, 0x00, 0x00, 0x2f, 0x02, 0xff, 0x10, 0x3a, 0x01, # def message hdr
$zid, 0x00, 0x03,
# it's magic, i ain't gotta explain shit
#0x0e, 0x00,
0x02, 0x00, 0x00, 0x00,
0x00, 0x00, 0x03, 0x00,
0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0xfe,
0x7e, 0x00, 0x02, 0x00,
$zlen, 0x00, 0x00, 0x04,
0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00,
0xfe, 0x7e, 0x00, $ztext,
0x17, # body end
);
my $header = pack('C3 v v C3 C2 C4 C2 C2',
0x16, 0x16, 0x01, # msg start
length($body),
++$self->{seqno},
0x00, 0x01, 0x00,
0x01, 0x01, # type = init
0x00, 0xc8, 0x01, 0x00, # sign id
0x00, ++$self->{sessno}, # session packet count
0x04, 0x00, # header end
);
my $footer = pack('vC',
crc($header.$body),
0x04, # msg end
);
$self->tx(&pkt_escape($header.$body.$footer));
print "sent zone $zid with seqno ", $self->{seqno}, " sessno ", $self->{sessno}, "\n";
$zid++;
}
}
=head2 message()
Sends a message to a zone. Accepts the zone name, message text and an
optional hashref containing any of the following parameters:
=over
=item priority
The message priority determines how the new message will replace an
existing one. The default is C<PRI_FOLLOW>, but can also be
C<PRI_OVERRIDE>, C<PRI_INTERRUPT>, C<PRI_YIELD> or C<PRI_ROUNDROBIN>.
=item activation_delay
Message activation delay in milliseconds. Default is 0.
=item display_deplay
Message display delay in milliseconds. Default is 0.
=item display_repeat
Not really sure. The default is 0.
=item ttl
The message will self-destruct in C<ttl> seconds. Default is 0.
=item sound_alarm
If true, the sign will beep when the message is displayed.
=back
=cut
sub message {
my ($self, $zname, $text, $param) = @_;
my $z = $self->{zones}->{$zname};
unless ($z) {
return undef;
}
print "sending to zone $zname with id ", $z->id, "\n";
my $ztext = &parse_msg($text);
my $zlen = length $ztext;
# uck
if ($zlen == 4 || $zlen == 5) {
$ztext = pack('C2', 0x10, 0x15).$ztext;
$zlen += 2;
}
my $body = pack("V C v v v v C C2 A[$zlen] C",
$zlen,
$param->{priority} || PRI_OVERRIDE,
$param->{activation_delay} || 0,
$param->{display_delay} || 0,
$param->{display_repeat} || 0,
$param->{ttl} || 0,
($param->{sound_alarm} ? 0xff : 0xfe),
0x00, 0x00, # msg slot
$ztext,
0x17, # body end
);
my $maskbytes = $z->id / 8;
if (int($maskbytes) != $maskbytes) { $maskbytes = int($maskbytes) + 1 }
my $zmask = pack($z->id > 0xff ? 'v' : 'C', 1 << ($z->id - 1));
my $zmlen = length $zmask;
printf("zmask: %s bytes: %d\n", unpack('H*', $zmask), $maskbytes);
my $header = pack("C3 v v C3 C2 Ca[$zmlen] C2",
0x16, 0x16, 0x01, # msg start
length($body) + 1,
++$self->{seqno},
0x00, 0x01, 0x00,
0x03, $maskbytes * 8,
0x00, $zmask,
0x02, 0x00, # header end
);
my $footer = pack('vC',
crc($header.$body),
0x04, # msg end
);
$self->tx(&pkt_escape($header.$body.$footer));
}
=head2 reboot()
Instructs the sign to reboot.
=cut
sub reboot {
my $self = shift;
my $pkt = pack('C3vvC4C*',
0x16, 0x16, 0x01, # msg start
2, # body length
++$self->{seqno}, # packet count
0x00, 0x01, 0x00,
0x01, 0x01, # msg type: reset
0x00, 0xc8, 0x01, 0x00, # sign id
0x00, 0x01, 0x0f, 0x00, # reset msg
0x17, # crc follows
);
$pkt .= pack('vC',
crc($pkt),
0x04, # msg end
);
$self->tx(&pkt_escape($pkt));
}
=head1 Message Formatting
The NetBrite signs have a few formatting switches that can be applied
in-line to messages. This is implemented as a kind of markup.
=over
=item C<{scrolloff}>, C<{scrollon}>
Turns scrolling on or off. This works in the middle of a message, but
seems to have a tendency to mess things up.
=item C<{blinkon}>, C<{blinkoff}>
Turns blinking on or off.
=item C<{red}>, C<{green}>, C<{yellow}>
Changes the text color.
=item C<{left}>, C<{center}>, C<{right}>
Changes the text's alignment within its zone.
=item C<{pause}>
Briefly pauses the display, probably for the amount of time specified
in the zone definition.
=item C<{erase}>
Erases.
=item C<{serial}>
Inserts the sign's serial number, which seems to always be its
Ethernet MAC address.
=item C<{bell}>
Beeps.
=item C<{note [pitch] [duration]}>
Beeps at C<pitch> for C<duration>. The pitch is a positive integer, possibly
0-254 and the duration is in milliseconds.
=item C<{tune [1-9] ["repeat"]}>
Plays one of nine predefined tunes. #9 is Charge!
If I<repeat> is specified, the tune will play every time the message is
displayed. This is extremely annoying.
=item C<{font [font_name]}>
Switches to C<font_name>. See L</Available Fonts>.
Note that the sign won't change to a font that's taller than its
containing zone.
=back
=head1 Available Fonts
The following fonts are available:
=over
=item monospace_7
=item monospace_16
=item monospace_24
=item proportional_7
=item proportional_5
=item proportional_9
=item proportional_11
=item bold_proportional_7
=item bold_proportional_11
=item script_16
=item picture_24
=back
=cut
sub parse_msg {
my $msg = shift;
$msg =~ s!\{scrolloff\}!pack('C*', 0x10, 0x14)!ieg;
$msg =~ s!\{scrollon\}!pack('C*', 0x10, 0x15)!ieg;
$msg =~ s!\{blinkoff\}!pack('C*', 0x10, 0x01)!ieg;
$msg =~ s!\{blinkon\}!pack('C*', 0x10, 0x00)!ieg;
$msg =~ s!\{red\}!pack('C*', 0x10, 0x0c, COLOR_RED)!ieg;
$msg =~ s!\{green\}!pack('C*', 0x10, 0x0c, COLOR_GREEN)!ieg;
$msg =~ s!\{yellow\}!pack('C*', 0x10, 0x0c, COLOR_YELLOW)!ieg;
$msg =~ s!\{left\}!pack('C*', 0x10, 0x27)!ieg;
$msg =~ s!\{center\}!pack('C*', 0x10, 0x29)!ieg;
$msg =~ s!\{right\}!pack('C*', 0x10, 0x28)!ieg;
$msg =~ s!\{pause\}!pack('C*', 0x10, 0x05)!ieg;
$msg =~ s!\{erase\}!pack('C*', 0x10, 0x03)!ieg;
$msg =~ s!\{serial\}!pack('C*', 0x10, 0x09)!ieg;
$msg =~ s!\{bell\}!pack('C*', 0x10, 0x05)!ieg;
$msg =~ s!\{note\s+(\d+)\s+(\d+)\}!pack('C2Cv', 0x10, 0x11, $1, $2)!ieg;
$msg =~ s!\{tune\s+([1-9])(\s+repeat)?\}!pack('C2C', 0x10, ($2 ? 0x0a : 0x0b), $1)!ieg;
$msg =~ s!\{font\s+(\S+)\}!pack('C2C', 0x10, 0x0d, $fonts{$1})!ieg;
return $msg;
}
=head1 BUGS
There is no error checking of any kind.
Handling of sequence numbers should probably be better.
We don't bother to set the time on the sign, or do any of the
time/date formatting stuff. Sorry, I don't use it; send patches.
No support for message slots.
Socket handling stuff is embarrassing.
=head1 AUTHOR
Ben Wilber <ben@desync.com>
Most of the credit goes to the author of
L<NetPenguin Server|http://www.thepenguinmaster.com/>, who did the
hard work of figuring out the protocol. Consider supporting that
project if you find this useful.
=head1 LICENSE
This library is free software and may be distributed under the same
terms as Perl itself.
=cut
1;

119
lib/Net/Symon/NetBrite/Zone.pm Normal file
View file

@ -0,0 +1,119 @@
package Net::Symon::NetBrite::Zone;
require Carp;
=head1 NAME
Net::Symon::NetBrite::Zone - Define a NetBrite zone
=head1 SYNOPSIS
my $zone = new Net::Symon::NetBrite::Zone(
rect => [0, 0, 200, 24],
);
=head1 CREATING A ZONE
To create a zone, call C<new()>. The only required parameter is C<rect>; the
rest are optional.
=over
=item rect
Accepts an arrayref that defines the position and size of the zone in LEDs.
The first two parameters are the upper left bound of the rectangle. The last
two are the lower right bound. For example,
rect => [10, 10, 20, 20]
would create a 10x10 area 10 LEDs from the top left corner.
B<ACHTUNG:> Don't create zones that overlap, are bigger than your sign,
zero/negative size or other stupidity. This can crash or hang your sign.
=item scroll_speed
The speed of scrolling text in the zone. The default is C<SCROLL_MED>, but can
also be C<SCROLL_SLOW> or C<SCROLL_FAST>.
=item pause_duration
The duration in milliseconds of any pause sequences in the message text. I
think.
=item volume
The volume of beeps, notes, alarms and other noises. Valid range is 0 (off) to
8 (deadly). Default is 4.
=item default_font
The default font. See L<Net::Symon::NetBrite/available_fonts>.
=item default_color
The default color. Can be C<COLOR_RED>, C<COLOR_GREEN> or C<COLOR_YELLOW>.
The default is red.
=item initial_text
The text initially displayed in the zone. This is just "." by default.
=back
=cut
sub new {
my ($class, %data) = @_;
my $self = {};
if (defined $data{rect}) {
$self->{rect} = $data{rect};
} else {
croak("Must supply rect");
}
$self->{scroll_speed} = $data{scroll_speed} || Net::Symon::NetBrite::SCROLL_MED;
$self->{pause_duration} = $data{pause_duration} || 1000;
$self->{volume} = $data{volume} || 4;
$self->{default_font} = $data{default_font} || 'proportional_5';
$self->{default_color} = $data{default_color} || Net::Symon::NetBrite::COLOR_RED;
$self->{initial_text} = $data{initial_text} || '.';
bless($self, $class);
return $self;
}
sub id {
my ($self, $newid) = @_;
if ($newid) {
$self->{id} = $newid;
}
return $self->{id};
}
sub get {
my ($self, $k) = @_;
unless (defined $self->{$k}) { warn "$k undefined" }
return $self->{$k};
}
=head1 AUTHOR
Ben Wilber <ben@desync.com>
=head1 LICENSE
This library is free software and may be distributed under the same
terms as Perl itself.
=cut
1;

96
signcontrol Executable file
View file

@ -0,0 +1,96 @@
#!/usr/bin/perl
use strict;
use warnings;
use lib 'lib';
use Net::Symon::NetBrite qw(:constants);
use Net::Symon::NetBrite::Zone;
use Getopt::Long;
use Net::Symon::NetBrite;
my $zone_array_ref;
my $message_array_ref;
my $address;
my $priority;
my $activation_delay;
my $display_delay;
my $display_repeat;
my $ttl;
my $sound_alarm;
GetOptions(
"zone=s@" => \$zone_array_ref,
"message=s@" => \$message_array_ref,
"address=s" => \$address,
"priority=s" => \$priority,
"activation_delay=i"=> \$activation_delay,
"display_delay=i" => \$display_delay,
"display_repeat=i" => \$display_repeat,
"ttl=i" => \$ttl,
"sound_alarm" => \$sound_alarm
);
die "Error: --address parameter is required.\n" unless defined $address;
die "Error: At least one --zone parameter is required.\n" unless defined $zone_array_ref && @{$zone_array_ref};
die "Error: --message parameter must be provided for each zone.\n" unless defined $message_array_ref && @{$message_array_ref} == @{$zone_array_ref};
my %zones;
foreach my $zone_str (@{$zone_array_ref}) {
my ($name, $definition) = split /=/, $zone_str, 2;
die "Error: Invalid zone format. Use name=definition.\n" unless defined $name && defined $definition;
my %props = parse_zone_string($definition);
if (exists $props{'x'} && exists $props{'y'} && exists $props{'width'} && exists $props{'height'}) {
my $x1 = $props{'x'};
my $y1 = $props{'y'};
my $x2 = $x1 + $props{'width'} - 1;
my $y2 = $y1 + $props{'height'} - 1;
$props{'rect'} = [$x1, $y1, $x2, $y2];
delete $props{'x'};
delete $props{'y'};
delete $props{'width'};
delete $props{'height'};
}
$zones{$name} = Net::Symon::NetBrite::Zone->new(%props);
}
my %messages;
foreach my $message_str (@{$message_array_ref}) {
my ($name, $text) = split /=/, $message_str, 2;
die "Error: Invalid message format. Use name=message text.\n" unless defined $name && defined $text;
die "Error: Zone '$name' not defined.\n" unless exists $zones{$name};
$messages{$name} = $text; # Use the message as-is, including any formatting tags
}
my $sign = Net::Symon::NetBrite->new(address => $address);
$sign->zones(%zones);
my %message_params;
$message_params{activation_delay} = $activation_delay if defined $activation_delay;
$message_params{display_delay} = $display_delay if defined $display_delay;
$message_params{display_repeat} = $display_repeat if defined $display_repeat;
$message_params{ttl} = $ttl if defined $ttl;
$message_params{sound_alarm} = 1 if defined $sound_alarm;
if ($priority) {
$message_params{priority} = PRI_OVERRIDE if $priority eq 'override';
$message_params{priority} = PRI_INTERRUPT if $priority eq 'interrupt';
$message_params{priority} = PRI_FOLLOW if $priority eq 'follow';
$message_params{priority} = PRI_YIELD if $priority eq 'yield';
$message_params{priority} = PRI_ROUNDROBIN if $priority eq 'roundrobin';
}
foreach my $name (keys %messages) {
$sign->message($name, $messages{$name}, \%message_params); # Pass raw message
}
sub parse_zone_string {
my ($str) = @_;
my %hash;
for my $pair (split /,/, $str) {
my ($key, $value) = split /=/, $pair;
$hash{$key} = $value;
}
return %hash;
}