cmora111 has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to find out what is wrong with my perl code...the write format seems to fail during the call to write but the values are there just prior to the call. 

X10::Config::printConfig(lib/X10/Config.pm:161):
161:            if ( $struct->type =~ /BATTERY|SECURITY|STATE|MOTION|L
+IGHT|FAN|CAMERA|CHRISTMAS/ ) {
  DB<1> p $type
ZONE
  DB<2> p $name
Indoor
  DB<3> p $action
G3
  DB<4> n
X10::Config::printConfig(lib/X10/Config.pm:173):
173:            if ( $struct->type =~ /ZONE/ ) {
  DB<4> n
X10::Config::printConfig(lib/X10/Config.pm:174):
174:                select((select(OUTFILE), $~ = "outputFormatZone")[
+0]);
  DB<4> p $type
ZONE
  DB<5> n
X10::Config::printConfig(lib/X10/Config.pm:175):
175:                write(OUTFILE);
  DB<5> p $type
ZONE
  DB<6> n
Variable "$action" is not available at lib/X10/Config.pm line 175.
 at lib/X10/Config.pm line 175.
    X10::Config::printConfig("/home/mora/Projects/X10/NEWX10/X10/Confi
+g", X10::Zone=HASH(0x1793008)) called at bin/X10.pl line 46
Variable "$name" is not available at lib/X10/Config.pm line 175.
 at lib/X10/Config.pm line 175.
    X10::Config::printConfig("/home/mora/Projects/X10/NEWX10/X10/Confi
+g", X10::Zone=HASH(0x1793008)) called at bin/X10.pl line 46
Variable "$type" is not available at lib/X10/Config.pm line 175.
 at lib/X10/Config.pm line 175.
    X10::Config::printConfig("/home/mora/Projects/X10/NEWX10/X10/Confi
+g", X10::Zone=HASH(0x1793008)) called at bin/X10.pl line 46
X10::Config::printConfig(lib/X10/Config.pm:48):
48:    $type,                $name,                  $action
49:    .
  DB<6> q

[download]

package X10::Zone;


#---------------------------------------------------------------------
+---------#
# Libraries.                                                          
+         #
#---------------------------------------------------------------------
+---------#

use 5.006;
use version; our $VERSION = qv('0.01');
use lib qw'lib/ ../lib';
use strict;
use warnings;
use Data::Dumper;

#---------------------------------------------------------------------
+---------#
# Attributes.                                                         
+         #
#---------------------------------------------------------------------
+---------#

sub new {
     my $self                 = {};
        $self->{TYPE}         = undef;
        $self->{PARENT}       = undef;
        $self->{NAME}         = undef;
        $self->{SECURITY}     = undef;
        $self->{STATE}        = undef; 
        $self->{BATTERY}      = undef;
        $self->{HU}           = undef;
        $self->{LIST}         = {};
        bless($self);
    return $self;
}

sub type {
    my $self = shift;
    if (@_) { $self->{TYPE} = shift }
    return $self->{TYPE};
}

sub parent {
    my $self = shift;
    if (@_) { $self->{PARENT} = shift }
    return $self->{PARENT};
}

sub name {
    my $self = shift;
    if (@_) { $self->{NAME} = shift }
    return $self->{NAME};
}

sub security {
    my $self = shift;
    if (@_) { $self->{SECURITY} = shift }
    return $self->{SECURITY};
}

sub state {  
    my $self = shift;
    if (@_) { $self->{STATE} = shift }
    return $self->{STATE};
}

sub battery {
    my $self = shift;
    if (@_) { $self->{BATTERY} = shift }
    return $self->{BATTERY};
}

sub hu {
    my $self = shift;
    if (@_) { $self->{HU} = shift }
    return $self->{HU};
}

sub list {
    my $self = shift;
    if (@_) { $self->{LIST} = shift }
    return $self->{LIST};
}

sub add_to_list {
    my ($self, $name, $zone) = @_;

    my $zone_list = $self->list;
    $zone_list->{$name} = $zone;

    $self->list($zone_list);
}

[download]

package X10::Config;

#---------------------------------------------------------------------
+---------#
# Libraries.                                                          
+         #
#---------------------------------------------------------------------
+---------#

use 5.006;
use version; our $VERSION = qv('0.01');
use lib qw'lib/ ../lib';
use strict;
use warnings;
use Data::Dumper;

#---------------------------------------------------------------------
+---------#
# Attributes.                                                         
+         #
#---------------------------------------------------------------------
+---------#

use IO::Handle;

use X10::Zone;
use X10::Item;

my $configfile = "/home/mora/Projects/X10/NEWX10/X10/Config";
my $type = "";
my $name = "";
my $action = "";

#2345678901234567890123456789012345678901234567890
format outputFormatZone = 
@<<<<<<<<             @<<<<<<<<<<<<<<<<<<<<   @<<<<
$type,                $name,                  $action
.

format outputFormatGroup =
    @<<<<<<<<         @<<<<<<<<<<<<<<<<<<<<   @<<<<
    $type,            $name,                  $action
.

format outputFormatArea =
        @<<<<<<<<     @<<<<<<<<<<<<<<<<<<<<
        $type,        $name
.

format outputFormatItem =
            @<<<<<<<< @<<<<<<<<<<<<<<<<<<<<   @<<<<
            $type,    $name,                  $action
.

sub new {
    my ($self) = {};
        $self->{HOUSE} = X10::Zone->new();
    bless($self);
    return $self
}

sub loadConfig {
    my $configfile = shift;
    my $house = shift;
    my $prevStruct = '';
    my $struct = $house;

    open(INFILE, "<$configfile");
    while(<INFILE>) {
        chomp();
        s/^\s+//g;
        s/\s+/ /;
        ($type,$name,$action) = split / /, $_;
        /ZONE|GROUP|AREA/ && do {
            $prevStruct = $struct; 
            $struct = X10::Zone->new(
                type         => $type,
                parent       => $prevStruct,
                name         => $name,
                hu           => $action,
            );
        };
        /BATTERY/ && do {
            $struct->{battery} = $action;
        };
        /SECURITY/ && do {
            $struct->{security} = $action;
        };
        /STATE/ && do {
            $struct->{state} = $action;
        };
        /LIGHT|FAN|CAMERA|CHRISTMAS/ && do {
            my $item = X10::Item->new(
                parent      => $struct,
                type        => $type,
                name        => $name,
                state       => 'OFF',
                hu          => $action,
                dimlevel    => 0,
            );
        };
    }
    close(INFILE);

    return $house;
}

sub dumpList {
    my $self = shift;
    my $space = shift;
    my $fh = shift;

    foreach my $type (values %{$self->list}) {
        printf $fh "%s%s             %s         %s\n", $space,$type->t
+ype,$type->name,$type->hu;
        my $tspace = "$space    ";
        printf $fh "%sSECURITY          %s         %s\n", $tspace,$typ
+e->name,$type->security;
        printf $fh "%sSTATE             %s         %s\n", $tspace,$typ
+e->name,$type->state;
        printf $fh "%sBATTERY           %s         %s\n", $tspace,$typ
+e->name,$type->battery;
        if ($type->type =~ /ZONE|GROUP/) {
            &dumpList($type,$tspace,$fh);
        } elsif ( $type->type =~ /AREA/ ) {
            foreach my $item (values %{$type->list}) {
                printf $fh "%s%s         %s            %s\n", $tspace,
+$item->type,$item->name,$item->hu;
            }
        }
    }
}
         
sub dumpConfig {
    my $configfile = shift;
    my $house = shift;


    open(my $fh, ">$configfile");
    my $space = "";
    &dumpList($house,$space,$fh);
    close($fh);
}

sub printConfig {
    my $configfile = shift;
    my $house = shift;

    open(OUTFILE, ">$configfile");
    select(OUTFILE);
    foreach my $struct (values %{$house->list}) {
        $type = $struct->type;
        $name = $struct->name;
        $action = $struct->hu;
        if ( $struct->type =~ /BATTERY|SECURITY|STATE|MOTION|LIGHT|FAN
+|CAMERA|CHRISTMAS/ ) {
            if ( $struct->type =~ /BATTERY/ ) {
                $action = $struct->battery;
            } elsif ( $struct->type =~ /SECURITY/ ) {
                $action = $struct->security;
            } elsif ( $struct->type =~ /STATE/ ) {
                $action = $struct->state;
            } elsif ( $struct->type =~ /MOTION|LIGHT|FAN|CAMERA|CHRIST
+MAS/ ) {
                $action = $struct->hu;
            }
            write(OUTFILE);
        }
        if ( $struct->type =~ /ZONE/ ) {
            select((select(OUTFILE), $~ = "outputFormatZone")[0]);
            write(OUTFILE);
        }
        if ( $struct->type =~ /GROUP/ ) {
            select((select(OUTFILE), $~ = "outputFormatGroup")[0]);
            write(OUTFILE);
        }
        if ( $struct->type =~ /AREA/ ) {
            select((select(OUTFILE), $~ = "outputFormatArea")[0]);
            write(OUTFILE);
            select((select(OUTFILE), $~ = "outputFormatItem")[0]);
        }
    }
    # close($fh);
}

sub defaultConfig {
    my ($self) = shift;

    my $master = X10::Zone->new();

    $master->type('ZONE');
    $master->parent(undef);
    $master->name('Master');
    $master->security('OFF');
    $master->state('OFF');
    $master->battery('20180410');
    $master->hu('G1');

    my $outdoors = X10::Zone->new();

    $outdoors->type('ZONE');
    $outdoors->parent($master);
    $outdoors->name('Outdoor');
    $outdoors->security('OFF');
    $outdoors->state('OFF');
    $outdoors->battery('20180410');
    $outdoors->hu('G2');

    my $indoors = X10::Zone->new();

    $indoors->type('ZONE');
    $indoors->parent($master);
    $indoors->name('Indoor');
    $indoors->security('OFF');
    $indoors->state('OFF');
    $indoors->battery('20180410');
    $indoors->hu('G3');

    my $garage = X10::Zone->new();

    $garage->type('ZONE');
    $garage->parent($master);
    $garage->name('Garage');
    $garage->security('OFF');
    $garage->state('OFF');
    $garage->battery('20180410');
    $garage->hu('G4');

    $master->add_to_list($outdoors->name, $outdoors);
    $master->add_to_list($indoors->name, $indoors);
    $master->add_to_list($garage->name, $garage);

    my $frontdoor = X10::Zone->new();
    $frontdoor->type('GROUP');
    $frontdoor->parent($outdoors);
    $frontdoor->name('Frontdoor');
    $frontdoor->security('OFF');
    $frontdoor->state('OFF');
    $frontdoor->battery('20180410');
    $frontdoor->hu('G5');

    my $deck = X10::Zone->new();
    $deck->type('GROUP');
    $deck->parent($outdoors);
    $deck->name('Deck');
    $deck->security('OFF');
    $deck->state('OFF');
    $deck->battery('20180410');
    $deck->hu('G6');

    my $basement = X10::Zone->new();
    $basement->type('GROUP');
    $basement->parent($outdoors);
    $basement->name('Basement');
    $basement->security('OFF');
    $basement->state('OFF');
    $basement->battery('20180410');
    $basement->hu('G7');

    $outdoors->add_to_list($frontdoor->name, $frontdoor);
    $outdoors->add_to_list($deck->name, $deck);
    $outdoors->add_to_list($basement->name, $basement);

    my $attic = X10::Zone->new();
    $attic->type('GROUP');
    $attic->parent($indoors);
    $attic->name('Attic');
    $attic->security('OFF');
    $attic->state('OFF');
    $attic->battery('20180410');
    $attic->hu('G8');

    my $firstfloor = X10::Zone->new();
    $firstfloor->type('GROUP');
    $firstfloor->parent($indoors);
    $firstfloor->name('FirstFloor');
    $firstfloor->security('OFF');
    $firstfloor->state('OFF');
    $firstfloor->battery('20180410');
    $firstfloor->hu('G9');

    my $secondfloor = X10::Zone->new();
    $secondfloor->type('GROUP');
    $secondfloor->parent($indoors);
    $secondfloor->name('SecondFloor');
    $secondfloor->security('OFF');
    $secondfloor->state('OFF');
    $secondfloor->battery('20180410');
    $secondfloor->hu('G10');

    my $Basement = X10::Zone->new();
    $Basement->type('GROUP');
    $Basement->parent($indoors);
    $Basement->name('Basement');
    $Basement->security('OFF');
    $Basement->state('OFF');
    $Basement->battery('20180410');
    $Basement->hu('G11');

    $indoors->add_to_list($attic->name, $attic);
    $indoors->add_to_list($firstfloor->name, $firstfloor);
    $indoors->add_to_list($secondfloor->name, $secondfloor);
    $indoors->add_to_list($Basement->name, $Basement);

    my $Attic = X10::Zone->new();
    $Attic->type('GROUP');
    $Attic->parent($attic);
    $Attic->name('Attic');
    $Attic->security('OFF');
    $Attic->state('OFF');
    $Attic->battery('20180410');
    $Attic->hu('G12');

    $Attic->add_to_list($Attic->name, $Attic);

    my $entryway = X10::Zone->new();
    $entryway->type('AREA');
    $entryway->parent($firstfloor);
    $entryway->name('EntryWay');
    $entryway->security('OFF');
    $entryway->state('OFF');
    $entryway->battery('20180410');
    $entryway->hu('G13');

    my $entrywaylight = X10::Item->new();
    $entrywaylight->parent($entryway);
    $entrywaylight->type('LIGHT');
    $entrywaylight->name('Entryway Light');
    $entrywaylight->state('OFF');
    $entrywaylight->hu('N1');
    $entrywaylight->dimlevel(0);

    $entryway->add_to_list($entrywaylight->name, $entrywaylight);

    my $livingroom = X10::Zone->new();
    $livingroom->type('AREA');
    $livingroom->parent($firstfloor);
    $livingroom->name('Livingroom');
    $livingroom->security('OFF');
    $livingroom->state('OFF');
    $livingroom->battery('20180410');
    $livingroom->hu('G14');

    $firstfloor->add_to_list($entryway->name, $entryway);
    $firstfloor->add_to_list($livingroom->name, $livingroom);

    print Dumper $master;

    return $master;
}

[download]

#!/usr/bin/perl

use Getopt::Long;
use version; our $VERSION = qv('0.01');
use lib qw'lib/ ../lib';
use warnings;
use strict;

use X10::Config;
use X10::Zone;
use X10::Item;

use Data::Dumper;

my $configfile = "/home/mora/Projects/X10/NEWX10/X10/Config";

my $house = X10::Config->new();

if ( not -e $configfile ) {
    my $master = X10::Config::defaultConfig(X10::Config::defaultConfig
+,$house);
    X10::Config::printConfig($configfile, $master);
}

[download]
This is what I am trying to get the output to look like: 

ZONE                 Master                 G1 
    SECURITY         Master                 OFF
    STATE            Master                 OFF
    BATTERY          Master                 20180506
ZONE                 Garage                 G2
    SECURITY         Garage                 OFF
    STATE            Garage                 OFF
    BATTERY          Garage                 20180506
    GROUP            Garage                 G3
        SECURITY     Garage                 OFF
        STATE        Garage                 OFF
        BATTERY      Garage                 20180506
        AREA         Garage                 G4
            SECURITY Garage                 OFF
            STATE    Garage                 OFF
            BATTERY  Garage                 20180506
            LIGHT    Garage_Light           N1
            FAN      Garage_Fan             N2
    GROUP            Garage_Outside         G5
        SECURITY     Garage_Outside         OFF
        STATE        Garage_Outside         OFF
        BATTERY      Garage_Outside         20180506
        AREA         Garage_Outside_Front   G6
            SECURITY Garage_Outside_Front   OFF
            STATE    Garage_Outside_Front   OFF
            BATTERY  Garage_Outside_Front   20180506
            LIGHT    Garage_Outside_Light   N3
            CAMERA   Garage_Outside_Camera  N4

[download]

Replies are listed 'Best First'.
Re: write command failing
by shmem (Chancellor) on May 07, 2018 at 23:59 UTC

    The variables used in the format spec for the format directive and those used by write must be compiled into the same scope, or be visible in each other's. Just an idea, can't tell from the code you posted whether that's not the case.

    perl -le'print map{pack c,($-++?1:13)+ord}split//,ESEL'
[reply]
Re: write command failing
by huck (Prior) on May 07, 2018 at 23:52 UTC

    Im going to suggest that adding use strict; use warnings; to the top of your programs might sort this out more.

    what you didnt show was where those formats were made, what namespace they are in and how they reflect the namespace that printConfig is in. i am suspecting that where the formats were defined the $action it is looking for is not in the same namespace that printConfig is in when it is running. therefor when the format is executed it cannot find the variable $action in its namespace, even tho an $action is available in the printConfig namespace

[reply]
[d/l]
      I added the whole libraries and the script. As you can see, I am using "use sstrict; use warnings;". The definition of $type, $name, and $action are defined in the global Config.pm scope. Which is visible in the perl -d output provided.

      I'm just not sure what I'm doing wrong. Any help would be greatly appreciated. And any suggestions as to how to output the Config file as shown. Each ZONE, GROUP, AREA and ITEM (LIGHT, FAN, CAMERA) are at different indentations, but would like to keep the name field and the hu field aligned.

[reply]
Re: write command failing
by roboticus (Chancellor) on May 08, 2018 at 14:35 UTC

    cmora111:

    I've looked over your code a bit, and would like to give a better critique of it, but I don't really have the time for that right now. What I had time for, though, was this:

    • Change the bit from:
           my $type = "";
     my $name = "";
     my $action = "";

      [download]

      to:
          our ($type,$name,$action);and you'll get some values in your output file. The scoping is getting confused a bit, but I don't know why. (There are a few oddities in your program that make it unclear to me at present.)
    • You didn't provide the source code to X10::Item, so I had to comment out the references to it in the code you did provide, and that seemed to be enough for some simple debugging.
    • In X10::Config::printConfig, your if statement for the ZONE case doesn't set $action so it's using the default value from the HU item, which appears to be undefined for a zone.
    • For debugging output formats, I frequently find it useful to add some unique text at the end of each format line for debugging (to ensure that the correct format line is selected and is printing), kind of like this:
       format fmtZone =
 @<<<<       @<<<<<<  @<<<<<    dbgZONE
 $type,      $name,   $action
 .
 format fmtGroup =
      @<<<<  @<<<<<<  @<<<<<<   dbgGROUP
      $type, $name,   $action
 .

      [download]
      Your program was generating a file of blank lines, so without the debug text on the format lines, I couldn't tell which bits of code were actually executing.
    • While I'm personally a fan of the format statements, you'll likely get a few messages suggesting you use printf statements. It's not a bad idea to consider them. Another interesting alternative can be pack. I generally use printf statements because:
      1. the format is immediately next to the code generating the report, and
      2. I frequently generate the formats on the fly to accommodate the data widths in the data for which I'm creating my reports.

    I really don't expect to have any time for it today, but if the chance arises, I'll look over the code again later and try to offer a few more pointers.

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

[reply]
[d/l]
[select]
      Thank you very much for your input. It is very helpful. I am enclosing package X10::Item.pm. 
      
package X10::Item;


#---------------------------------------------------------------------
+---------#
# Libraries.                                                          
+         #
#---------------------------------------------------------------------
+---------#

use 5.006;
use version; our $VERSION = qv('0.01');
use lib qw'lib/ ../lib';
use strict;
use warnings;
use Data::Dumper;
#---------------------------------------------------------------------
+---------#
# Attributes.                                                         
+         #
#---------------------------------------------------------------------
+---------#

sub new {
    my $self  = {};
        $self->{PARENT}       = undef;
        $self->{TYPE}         = undef;
        $self->{NAME}         = undef;
        $self->{STATE}        = undef;
        $self->{HU}           = undef;
        $self->{DIMLEVEL}     = undef;
        bless($self);
    return $self;
}

sub parent {
    my $self = shift;
    if (@_) { $self->{PARENT} = shift }
    return $self->{PARENT};
}

sub type {
    my $self = shift;
    if (@_) { $self->{TYPE} = shift }
    return $self->{TYPE};
}

sub name {
    my $self = shift;
    if (@_) { $self->{NAME} = shift }
    return $self->{NAME};
}

sub state {
    my $self = shift;
    if (@_) { $self->{STATE} = shift }
    return $self->{STATE};
}

sub hu {
    my $self = shift;
    if (@_) { $self->{HU} = shift }
    return $self->{HU};
}

sub dimlevel {
    my $self = shift;
    if (@_) { $self->{DIMLEVEL} = shift }
    return $self->{DIMLEVEL};
}

sub timer {
    my $self = shift;
    if (@_) { $self->{TIMER} = shift }
    return $self->{TIMER};
}
1;

      [download]
[reply]
[d/l]
      I modified printConfig and printList as follows and things are working now without the write format. 
      sub printList {
    my $self = shift;
    my $fh = shift;

    foreach my $struct (values %{$self->list}) {
        $type = $struct->type;
        $name = $struct->name;
        $action = $struct->hu;
        if ( $struct->type =~ /LIGHT|FAN|CAMERA|CHRISTMAS/ ) {
            printf($fh "            %s     %-22s %s\n", $struct->type,
+$struct->name,$struct->hu);
        }
        if ( $struct->type =~ /ZONE/ ) {
            printf($fh "ZONE                  %-22s %s\n", $struct->na
+me,$struct->hu); 
            printf $fh "    SECURITY          %-22s %s\n", $struct->na
+me,$struct->security;
            printf $fh "    STATE             %-22s %s\n", $struct->na
+me,$struct->state;
            printf $fh "    BATTERY           %-22s %s\n", $struct->na
+me,$struct->battery;
            &printList($struct,$fh);
        }
        if ( $struct->type =~ /GROUP/ ) {
            printf($fh "    GROUP             %-22s %s\n", $struct->na
+me,$struct->hu); 
            printf $fh "        SECURITY      %-22s %s\n", $struct->na
+me,$struct->security;
            printf $fh "        STATE         %-22s %s\n", $struct->na
+me,$struct->state;
            printf $fh "        BATTERY       %-22s %s\n", $struct->na
+me,$struct->battery;
            &printList($struct,$fh);
        }
        if ( $struct->type =~ /AREA/ ) {
            printf($fh "        AREA          %-22s %s\n", $struct->na
+me,$struct->hu); 
            printf $fh "            SECURITY  %-22s %s\n", $struct->na
+me,$struct->security;
            printf $fh "            STATE     %-22s %s\n", $struct->na
+me,$struct->state;
            printf $fh "            BATTERY   %-22s %s\n", $struct->na
+me,$struct->battery;
            &printList($struct,$fh);
        }

    }
}

sub printConfig {
    my $configfile = shift;
    my $house = shift;
    my $space = "";

    open(my $fh, ">$configfile");
    printf($fh "ZONE                  %-22s %s\n", $house->name,$house
+->hu); 
    printf $fh "    SECURITY          %-22s %s\n", $house->name,$house
+->security;
    printf $fh "    STATE             %-22s %s\n", $house->name,$house
+->state;
    printf $fh "    BATTERY           %-22s %s\n", $house->name,$house
+->battery;

    &printList($house,$fh,$house->type);

    close($fh);
}

      [download]
      The Config file now prints the way I wanted. I am sure there is a more compact way to do it though. 
      
ZONE                  Master                 G1
    SECURITY          Master                 OFF
    STATE             Master                 OFF
    BATTERY           Master                 20180410
ZONE                  Outdoor                G2
    SECURITY          Outdoor                OFF
    STATE             Outdoor                OFF
    BATTERY           Outdoor                20180410
    GROUP             Frontdoor              G5
        SECURITY      Frontdoor              OFF
        STATE         Frontdoor              OFF
        BATTERY       Frontdoor              20180410
    GROUP             Deck                   G6
        SECURITY      Deck                   OFF
        STATE         Deck                   OFF
        BATTERY       Deck                   20180410
    GROUP             Basement               G7
        SECURITY      Basement               OFF
        STATE         Basement               OFF
        BATTERY       Basement               20180410
ZONE                  Indoor                 G3
    SECURITY          Indoor                 OFF
    STATE             Indoor                 OFF
    BATTERY           Indoor                 20180410
    GROUP             SecondFloor            G10
        SECURITY      SecondFloor            OFF
        STATE         SecondFloor            OFF
        BATTERY       SecondFloor            20180410
    GROUP             FirstFloor             G9
        SECURITY      FirstFloor             OFF
        STATE         FirstFloor             OFF
        BATTERY       FirstFloor             20180410
        AREA          Livingroom             G14
            SECURITY  Livingroom             OFF
            STATE     Livingroom             OFF
            BATTERY   Livingroom             20180410
        AREA          EntryWay               G13
            SECURITY  EntryWay               OFF
            STATE     EntryWay               OFF
            BATTERY   EntryWay               20180410
            LIGHT     Entryway Light         N1
    GROUP             Basement               G11
        SECURITY      Basement               OFF
        STATE         Basement               OFF
        BATTERY       Basement               20180410
    GROUP             Attic                  G8
        SECURITY      Attic                  OFF
        STATE         Attic                  OFF
        BATTERY       Attic                  20180410
ZONE                  Garage                 G4
    SECURITY          Garage                 OFF
    STATE             Garage                 OFF
    BATTERY           Garage                 20180410

      [download]
[reply]
[d/l]
[select]

        my $f0="%-22s %s\n"; 
my $f1='%-22s'             .$f0; 
my $f2='    %-18s'         .$f0; 
my $f3='        %-14s'     .$f0;
my $f4='            %-10s' .$f0;

sub printList {
    my $self = shift;
    my $fh = shift;

    foreach my $struct (sort values %{$self->list}) {
        my $type = $struct->type;
        if ( $type =~ /LIGHT|FAN|CAMERA|CHRISTMAS/ ) {
            printf $fh $f4, $type,$struct->name,$struct->hu;
        }
        else{ 
          my ($ftop,$fline); 
          if ( $type =~ /ZONE/ )  { $ftop=$f1; $fline=$f2;} 
          if ( $type =~ /GROUP/ ) { $ftop=$f2; $fline=$f3;} 
          if ( $type =~ /AREA/ )  { $ftop=$f3; $fline=$f4;} 
          printSet($struct,$fh,$ftop,$fline); 
          printList($struct,$fh);
        }

    }
}

sub printSet  { 
  my $struct=shift; 
  my $fh=shift; 
  my $ftop=shift; 
  my $fline=shift; 
  $name = $struct->name;

  printf $fh $ftop, $struct->type,$name,$struct->hu; 
  for my $method (qw/security state battery/) { printf $fh $fline,uc($
+method),$name,$struct->$method; } 
} 

sub printConfig {

    my $configfile = shift;
    my $house = shift;
    my $space = "";

    open(my $fh, ">$configfile");
    printSet($house,$fh,$f1,$f2); 
    printList($house,$fh,$house->type);

    close($fh);
}

        [download]
        Of most interest here is that "methods" are nothing but string literals.

[reply]
[d/l]
Re: write command failing (perlform IO::Handle ->format_write)
by Anonymous Monk on May 10, 2018 at 21:00 UTC

    Hi,

    Since @_ is global, you can use constants to NAME your variables 

    package X10::Config;
use constant +{ qw{ TYPE 0 NAME 1 ACTION 2 } };
use namespace::clean; # "undefine" TYPE/NAME...outside of this scope
format outputFormatGroup =
    @<<<<<<<<         @<<<<<<<<<<<<<<<<<<<<   @<<<<
    $_[TYPE],            $_[NAME],                  $_[ACTION]
.

sub printConfigGroup {
    use IO::Handle;
    OUTPUT_HANDLE->format_write('outputFormatGroup');
}

    [download]

    Then later on something akin to 

    printConfigGroup( $struct->type, $struct->name, $struct->hu );

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom