Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Perl and HTML::Template - variable not passing

Posted on 2007-04-09
5
Medium Priority
?
272 Views
Last Modified: 2010-04-06
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;
}




0
Comment
Question by:chuckbeats
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
5 Comments
 
LVL 84

Expert Comment

by:ozo
ID: 18880777
Can you show how to get the incorrect output from that program, and indiicate the output that it should have?
0
 

Author Comment

by:chuckbeats
ID: 18881901
its an apache handler - returned from a detailed property listing on ebby dot com
0
 

Author Comment

by:chuckbeats
ID: 18881973
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
 
LVL 84

Accepted Solution

by:
ozo earned 1500 total points
ID: 18883931
the syntax $output{tuxedo} = 1;  creates a new hash key tuxedo with a value of 1
0
 

Author Comment

by:chuckbeats
ID: 18887048
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

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective of This Article In 1990’s, when I was a budding software professional, I had a lot of confusion about which stream or technology, I had to choose to build my career. In those days, I had lot of confusion like whether to choose System so…
While opting for any web-to-print solution, you need to discuss with your team and some of your end users and know their opinions about your decisions. In this article we list down some questions you need to ask yourself.
The purpose of this video is to demonstrate how to prevent comment spam on a WordPress Website. This will be demonstrated using a Windows 8 PC. Plugin Akismet will be used. Go to your WordPress login page. This will look like the following: myw…
The purpose of this video is to demonstrate how to set up basic WordPress SEO. This will be demonstrated using a Windows 8 PC. The plugin used will be WordPress SEO by Yoast. Go to your WordPress login page. This will look like the following: myw…

704 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question