Perl and HTML::Template - variable not passing

I cannot seem to get a variable to pass in perl / HTML::Template
The code in the template is fine - for instance if I use  an existing variable and it is true, what i want to show in my TMPL_IF NAME= displays properly. However I cannot seem to get it to pass a new variable.

The variable I want to create is the hash key for $output{tuxedo} and set it to true. I'm a PHPer so this is frustrating me. I can't find a reference to the hash outside of the perl package. Here is a code sample of Detail.pm - Many ####### WILL HELP SHOW WHERE I'M TRYIN TO ADD THE VARIABLE #######
The code is not complete and some things have been erased for security - although very little. There is the main program and the only sub that refers to the ouput hash. If you can figure this one out I will owe you forever, I'm losing my mind trying..................but I could just be an perl idiot and overlooking something.






package E::Details;

use Apache2::Const qw(:common);
use Apache2::Cookie ();
use strict;
use HTML::Template;
use HTML::Entities;
use DBI;
use E::DB;
use CGI;

sub new {
  my ( $class ) = @_;
  my ( $self ) = {};
  bless ($self, $class);
  $self->{'default'} = 'detail.tem';
  return $self;
}

sub handler {
  my $r    = shift;
  my $self = new E::Details;
  my $cgi  = new CGI;
  my $log  = $r->log();

  # copy values to object, just in case

  $self->{'r'}   = $r;
  $self->{'log'} = $log;
  $self->{'cgi'} = $cgi;

  # set path/location of template files

  my $docroot = $r->document_root();
  $self->{template}   = $docroot . '/templates/details.tmpl';

  #these locations are generally static

  $self->{'picdir'} = '/home/httpd';
  $self->{'picurl'} = 'http:/pix/';
  $self->{'thumburl'} = 'http:/bnail/';
  $self->{'agturl'} = '/a/';
  $self->{'limit'}  = 450;
  $self->{'x_limit'}  = 400;
  $self->{'ylimit'} = 500;
  $self->{'minimum_ratio'} = 0.9;

  # errors generate more info if debug mode = 1
  # they are stored in debug
 
  $self->{debugmode} = 0;
  $self->{debug} = '';
 
  # database connection stuff

  my $dbn  = new E::DB;
  my $conn = DBI->connect( $dbn->{dsn}, $dbn->{user}, $dbn->{pass} );

  unless ($conn) {
    $self->problem("Error: Couldn\'t connect to database.");
    return OK;
  }
  $self->{'db'} = $conn;     # copy db handle to the object

  # the propidx is extracted from the URI

  my $loc = $r->uri;
  my ( $dir, $propidx, $ext ) = ( $loc =~ /(\w+?)\/(-?\d+)(.*)$/i );

  unless ($propidx) {
    my ( $dir, $old_propidx, $ext ) = ( $loc =~ /(\w+?)\/(L\d+)(.*)$/i );
    $propidx = $self->get_propidx($old_propidx);
  }

  unless ($propidx) {
    $log->error( __PACKAGE__ . " -- propidx not found: $loc" );
    return NOT_FOUND;
  }

  if ($ext =~ /gif|jpe?g|png/i) {
    $log->error( __PACKAGE__ . " -- IMAGE WAS REQ\'D: $loc" );
    return NOT_FOUND;
  }

  $propidx = uc($propidx);
  $self->{'idx'} = $propidx;

  my $site = $r->get_server_name();
  if ($site =~ /e/i) {
    $self->{site} = 'e';
    $self->{etsite} = 'Y';
    $self->{'picurl'} = 'http://wwngpix/';
    $self->{'thumburl'} = 'http://wwwnail/';
  }

  my $home = $self->get_details($conn, $propidx);

  unless ($home) {
    $log->error( __PACKAGE__ . " -- property unmatched: $propidx " . $self->{debug} );
    return NOT_FOUND;
  }

  my %mainpage = $self->format_details($home, $propidx);
  $conn->disconnect;

  my $jar = Apache2::Cookie::Jar->new($r);
  my $c = $jar->cookies('referer');
  if ($c) {
    $mainpage{'referer'} = $c->value;
  }

 

  my $tem = HTML::Template->new(filename => $self->{'template'},
                                die_on_bad_params => 0);
  $tem->param(\%mainpage);
  my $doc = $tem->output;

  $r->content_type('text/html');
  $r->print( $doc );
  return OK;
}


#######################Here's the only reference to %output ###############################
## AND I WANT TO CREATE A VARIABLE NAMED $output{tuxedo} and set it true if a rule applies #####



sub format_details {
# prepare details for display on the page
  my ($self, $info, $idx) = @_;
  my %output;

  # copy direct transfer fields here
  # use the array to avoid clutter from other DB fields

  my @simple = qw(agent agent_url
    city descr dist email ext fence found
    address
    lot lp mapcord messph ofcidx offcity offname
    offstreet offzip pool proptype romance roof
    stories subdiv webarea offphone
    yrblt zip);

  foreach my $k (@simple) {
    $output{$k} = $info->{$k} || '';
  }

  my %rooms = (liv1 => 'living_1_desc',
               liv2 => 'living_2_desc',
               liv3 => 'living_3_desc',
               br1 => 'bedroom_1_desc',
               br2 => 'bedroom_2_desc',
                                     );

  foreach (keys %rooms) {
    if ($info->{$rooms{$_}}) {
      $output{$_} = $info->{$_}.' '.$info->{$rooms{$_}};
    } elsif ($info->{$_} !~ '0X0') {
      $output{$_} = $info->{$_};
    }
  }
  $output{'tuxedo'}='1';
  # Garage Description
  my $feat_gar = $self->getFeatures($info->{'feat_garage'}, 'feat_garage');
  if ($info->{'garage_spaces'} > 1) {
    $output{'gar'} = $info->{'garage_spaces'} . ' spaces' . ($feat_gar?", $feat_gar":"");
  } elsif ($info->{'garage_spaces'}) {
    $output{'gar'} = $info->{'garage_spaces'} . ' space' . ($feat_gar?", $feat_gar":"");
  } else {
    $output{'gar'} = $feat_gar;
  }

  # translate certain display_codes into English
  foreach my $field (qw(proptype)) {
    my $fieldtmp = $self->display_code(lc($info->{$field}));
    ($fieldtmp) and $output{$field} = $fieldtmp;
  }
 
  my @schools;
  for (1..4) {
    push @schools, {name => $info->{"school_$_"},
                    type => $self->school_code($info->{"school_type_$_"})}
         if ($info->{"school_$_"});
  }
  $output{schools} = \@schools;

  # copy overs with slight alterations
  $output{propidx} = $idx;
  $output{site} = $self->{site};
  $output{etsite} = $self->{etsite};

  $output{listprice} = '$' . $info->{listprice};
  $output{sqft} = $info->{sqft} . '* ' . $info->{sqftsrce};
  $output{mapcord} = $info->{map} . $info->{mapcord};

  # the state for everything is Texas... for now
  $output{state} = 'TX';
  $output{offstate} = 'TX';

  # mls number
  $output{mlsnum} = $info->{prcmlnum};

  $output{romance} = $info->{romance};
  foreach (1, 2, 3) {
    $output{romance} .= $info->{'romance'.$_} if ( $info->{'romance'.$_} ne "");
  }

  # Community Pool

  if ($info->{'feat_common'} =~ /03/ && $info->{'pool'} eq 'N') {
    $output{pool} = 'Community';
  }




 
 

 

  # HOA Dues
  my %hoa_bill = (
    A => 'Annual',
    M => 'Monthly',
    S => 'Semi-annual',
    O => 'Other',
    Q => 'Quarterly',
  );
  if ($info->{'hoa'} =~ /M|V/) {
    my $freq = $info->{'hoa'} eq 'M'?'Mandatory':'Voluntary';
    $output{'hoa'} = $info->{'hoa_dues'} .' '. $hoa_bill{$info->{'hoa_billing_frequency'}}
      ." ($freq)";
  }
   

 
  # BEGIN PHOTO HANDLING

  my %args;
  if ($info->{'source'} eq 'M' || $info->{mls_photos} eq 'Y') {
    $args{'M'} = $info->{prcmlnum};
  }
  if ($info->{'source'} eq 'E') {
    $args{'E'} = $idx;
    $args{'L'} = $info->{old_propidx};
  }
  my $pf = Ebby::PhotoFinder->new(%args);
  my @pics;

  my $limit = $self->{limit};
  $limit = $self->{mls_limit} if ( lc($info->{isebby}) eq "false");

  if ($pf->count() > 0) {
    $pf->set_max_width($limit);
    @pics = $pf->details();
  }    
 
  if (@pics) {  
    my $mainp = $pics[0];
    my ($picw, $pich) = ( $mainp->{width}, $mainp->{height} );
    $output{picture} = $mainp->{thumb}."?x=$mainp->{scaled_width};y=$mainp->{scaled_height}";
    $output{dimen} = sprintf( 'WIDTH=%d HEIGHT=%d',
                               $mainp->{scaled_width},
                               $mainp->{scaled_height} );
  }

  # detect if there is more than one picture

  if ($pf->count() > 1) {
    $output{morepictures} = 1;
  }

  # create list of pictures in directory

  my @gallery;
 
  foreach my $still (@pics) {
    my $shot = {};
    $shot->{photo} = $still->{id};
    ( $shot->{photowidth}, $shot->{photoheight} )
                 = ( $still->{width}, $still->{height} );
     
    if ( @gallery < 6 )
    {
      push @gallery, $shot;
    }
  }

  if (@pics > @gallery) {
    my $num = @pics - @gallery;
    for (1..$num) { push @gallery, {blah=>1}; }
    $output{gallerypage} = 1;
  }

  $output{gallery} = \@gallery;

  # END PHOTO HANDLING
  ##########################################################
  #############WHY DOES THIS BELOW NOT WORK, BUT IF I CAHNGE MY TEMPLATE TO
##### IF NAME="picture" IT WORKS FINE ##########################################
  $output{tuxedo} = 1;
  $output{pending} = ( $info->{'property_status'} =~ /P/ ) ? 1 : undef;

  $output{url_address} = $self->enc($info->{'address'});
  $output{url_city}    = $self->enc($output{city});

  my $tmp_idx = $idx;
  $tmp_idx =~ s/^L//i;
  $output{mqmap} = $tmp_idx unless ($info->{'web_map'} eq 'N');

  $output{hvac} = $self->getFeatures($info->{'feat_hvac'}, 'feat_hvac');
  $output{roof} = $self->getFeatures($info->{'feat_roof'}, 'feat_roof');
  $output{found} = $self->getFeatures($info->{'feat_foundation'}, 'feat_foundation');
  $output{fence} = $self->getFeatures($info->{'feat_fence'}, 'feat_fence');
  $output{ext} = $self->getFeatures($info->{'feat_construction'}, 'feat_construction');

 
  # feature list
  my @feat;
  push @feat, 'Ebby Select Home' if ($info->{ebbyselect} eq 'True');

  my @features = (
                  ['feat_exterior', 1, 'Balcony'],
                   ['feat_common', 14, 'Gated Community'],
                 ['feat_lot_desc', 12, 'Located next to Golf Course'],
                 ['feat_exterior', 13, 'Guest Quarters'],
                  ['feat_handicap', 0, 'Handicap Amenities'],
              ['feat_housing_type', 4, 'High Rise/Condominium'],
                 ['feat_lot_desc', 15, 'Lake Front Lot'],
                 ['feat_lot_desc', 14, 'Lake View'],
           ['feat_specialty_rooms', 3, 'Library/Study'],
              ['feat_house_style', 20, 'Loft'],
            ['feat_specialty_rooms', 5, 'Media Room'],
             ['feat_housing_type', 18, 'Mobile Home'],
              ['feat_housing_type', 3, 'Zero Lot Line']);

  foreach my $f (@features) {
    push @feat, $f->[2] if (
      ( ($f->[1] == 0) && ($info->{$f->[0]}) ) ||
      grep {$_ == $f->[1]} split('/', $info->{$f->[0]})
    );
  }
  if (@feat > 0) {
    $output{featurelist} = join(', ', @feat);
  }

  if ( lc($info->{iseb}) eq "true") {
    #  make the ebby agent/office info
    #
    #  template fields
    #  ofcidx, etsite, offname, offstreet, offcity, offstate,
    #  offzip, homeph, agent_url, agentname, messph, email,
    #  email

    my %office = $self->get_agent_info( $info->{pers_code} );

    $output{ebbyoffice} = 1;

    my @offinfo = qw(ofcidx offname offstreet offphone offcity
                     offstate offzip etsite);

    # copy values from %output for consistency of state, etsite
    foreach (@offinfo) { $office{$_} = $output{$_}; }
   
    foreach (qw(name homeph agentname messph email agtcode pgname)) {
      $output{$_} = $office{$_};
    }
 
    $output{agent_url} = $self->{agturl} . $office{pgname};

    my $tbuser = $info->{pers_code} || $info->{gtcode};
    # print STDERR "TBUSER: ", $tbuser, "\n";
    $output{talkbutton} = $self->talkbutton( $tbuser, $self->{'db'} );

    my $tour = E::VirtualTour->new( $self->{db}, $idx );

    if ( length($tour->url) > 0 ) {

       # button options may come back, but no one
       # is using them right now

       my %vbut = ( '0' => 'vtours',
                    '1' => 'addph',
                    '2' => 'addinf',
                    '3' => 'audio',
                    '4' => 'video' );

       my $vbutton = $vbut{'0'};
       my $vth = $tour->height;
       my $vtw = $tour->width;

       my $vlink = $tour->url;
       $vlink = 'http://'.$vlink unless ($vlink =~ /^http:\/\//);
       #$vlink = qq{javascript:Opener('} . $vlink
       #       . qq{','$vth','$vtw','no');};

       $output{vtour_link}   = $vlink;
       $output{vtour_button} = $vbutton;
       $output{vtour_height} = $tour->height;
       $output{vtour_width}  = $tour->width;
    }

    my $fplan = Ebby::FloorPlan->new( $self->{db}, $idx );

    if ( length($fplan->url) > 0 ) {

        my $fplink = $fplan->url;
        my $fpht   = $fplan->height;
        my $fpwd   = $fplan->width;
   
        $fplink = 'http://'.$fplink unless ($fplink =~ /^http:\/\//);
        #$fplink = qq{javascript:Opener('} . $fplink
        #        . qq{','$fpht','$fpwd','yes');};

        $output{floorplan_link}   = $fplink;
        $output{floorplan_height} = $fpht;
        $output{floorplan_width}  = $fpwd;
    }

 
    if ( lc($info->{showoh}) eq 'yes' ) {
      my $ohtext = qq#<B>Open House on # . $info->{openday} . ' ';
      $ohtext .= $info->{openmon} . ' ' . $info->{opendayofm};
      $ohtext .= ' at ' . $info->{opentime} if ($info->{opentime} ne "");
      $ohtext .= qq#</B>#;
      $output{openhouse} = $ohtext;
    }
 
    if ( $info->{homeshow} ) {
      $output{homeshow_link} = '/cgi-bin/homeshow_video.cgi?ref=' .
                                $info->{prcmlnum};
    }

 

    # 800 number message setting
    my $number_msg = $self->get_800_number();
    $output{'800number'} = ($number_msg) ? $number_msg : undef;

    $output{'appointment_formID'} = 1046;
    $output{'moreinfo_formID'} = 1047;
  }

  # weekday setting
  my $dow = (localtime(time))[6];
  $output{weekday} = 1 if ($dow != 0 and $dow != 6);

  return %output;
}




chuckbeatsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ozoCommented:
Can you show how to get the incorrect output from that program, and indiicate the output that it should have?
0
chuckbeatsAuthor Commented:
its an apache handler - returned from a detailed property listing on ebby dot com
0
chuckbeatsAuthor Commented:
more importantly, in perl -

using strict - the my %ouput is;   - inititates a hash

should the syntax $output{tuxedo} = 1;  create a new hash key tuxedo with a value of 1 or true for HTML::Template purposes
0
ozoCommented:
the syntax $output{tuxedo} = 1;  creates a new hash key tuxedo with a value of 1
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
chuckbeatsAuthor Commented:
Thanks for the help ozo - i think i owed you points from before. We have two instances of apache running - 1 with mod perl, one without, i was reloading the main instance without mod perl - so the changes I was making to my Apache Handler were not taking effect - somedays i just love computers
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Web Applications

From novice to tech pro — start learning today.