Solved

Perl and HTML::Template - variable not passing

Posted on 2007-04-09
5
225 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
  • 3
  • 2
5 Comments
 
LVL 84

Expert Comment

by:ozo
Comment Utility
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
Comment Utility
its an apache handler - returned from a detailed property listing on ebby dot com
0
 

Author Comment

by:chuckbeats
Comment Utility
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 500 total points
Comment Utility
the syntax $output{tuxedo} = 1;  creates a new hash key tuxedo with a value of 1
0
 

Author Comment

by:chuckbeats
Comment Utility
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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

Developer tools in browsers have been around for a while, yet they are still heavily underused by developers. Developers still fix html or CSS then refresh page to see effect, or they put alert or debugger in JavaScript and then try again and again …
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…
The purpose of this video is to demonstrate how to add AdSense Ads to a WordPress Website, and how to set up WordPress to automatically place Ads in Sidebars. This will be demonstrated using a Windows 8 PC. Log into your AdSense account. : Cli…
The purpose of this video is to demonstrate how to integrate Mailchimp with WordPress, by placing a Mailchimp signup form on a WordPress Page or Post. This will be demonstrated using a Windows 8 PC. Mailchimp will be used. Log into your Mailchi…

763 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now