From 94fb8b3c7be17a0c8ecd763a3dfcecdc9002e5ef Mon Sep 17 00:00:00 2001 From: Jurn Wubben Date: Tue, 5 Aug 2025 13:55:52 +0200 Subject: [PATCH] Init --- .envrc | 1 + .gitignore | 22 ++ Build.PL | 10 + Makefile.PL | 15 + README.md | 120 ++++++++ flake.lock | 26 ++ flake.nix | 40 +++ lib/Net/Symon/NetBrite.pm | 537 +++++++++++++++++++++++++++++++++ lib/Net/Symon/NetBrite/Zone.pm | 119 ++++++++ signcontrol | 96 ++++++ 10 files changed, 986 insertions(+) create mode 100644 .envrc create mode 100644 .gitignore create mode 100644 Build.PL create mode 100644 Makefile.PL create mode 100644 README.md create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 lib/Net/Symon/NetBrite.pm create mode 100644 lib/Net/Symon/NetBrite/Zone.pm create mode 100755 signcontrol diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..3550a30 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6a6fc48 --- /dev/null +++ b/.gitignore @@ -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 diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..ffca574 --- /dev/null +++ b/Build.PL @@ -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(); diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..9c8a714 --- /dev/null +++ b/Makefile.PL @@ -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', +); diff --git a/README.md b/README.md new file mode 100644 index 0000000..bb0835a --- /dev/null +++ b/README.md @@ -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. diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..7642d79 --- /dev/null +++ b/flake.lock @@ -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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..68520c6 --- /dev/null +++ b/flake.nix @@ -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 + ])) + ]; + }; + }; +} diff --git a/lib/Net/Symon/NetBrite.pm b/lib/Net/Symon/NetBrite.pm new file mode 100644 index 0000000..203ca56 --- /dev/null +++ b/lib/Net/Symon/NetBrite.pm @@ -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. + +=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 +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, but can also be +C, C, C or C. + +=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 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 for C. 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 is specified, the tune will play every time the message is +displayed. This is extremely annoying. + +=item C<{font [font_name]}> + +Switches to C. See L. + +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 + +Most of the credit goes to the author of +L, 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; diff --git a/lib/Net/Symon/NetBrite/Zone.pm b/lib/Net/Symon/NetBrite/Zone.pm new file mode 100644 index 0000000..9be9ce8 --- /dev/null +++ b/lib/Net/Symon/NetBrite/Zone.pm @@ -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. The only required parameter is C; 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 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, but can +also be C or C. + +=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. + +=item default_color + +The default color. Can be C, C or C. +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 + +=head1 LICENSE + +This library is free software and may be distributed under the same +terms as Perl itself. + +=cut + +1; diff --git a/signcontrol b/signcontrol new file mode 100755 index 0000000..0bcb1e2 --- /dev/null +++ b/signcontrol @@ -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; +}