expand results from the CPAN

expand

Apache-PageKit

view release on metacpan or search on metacpan

lib/Apache/PageKit/View.pm view on Meta::CPAN

    
    # check for recursive pkit_components
    if($view->{component_ids_hash}->{$cid_key} > 100){
      die "Likely recursive PKIT_COMPONENTS for component_id $component_id and giving up.";
    }

    my $template_ref = $view->_load_component($page_id, $component_id, $pkit_view, \%params);
    return $$template_ref;
  }
}

sub _is_record_uptodate {
  my ($view, $record, $pkit_view, $page_id) = @_;

  # first check timestamps
  my $include_mtimes = $record->{include_mtimes};
  while (my ($filename, $cache_mtime) = each %$include_mtimes){
    # check if file still exists
    unless(-f "$filename"){
      return 0;
    }

    # check if file is up to date
    my $file_mtime = (stat($filename))[9];
#    print "hi $filename - $cache_mtime - $file_mtime<br>";
    if($file_mtime != $cache_mtime){
      return 0;
    }

    if($filename =~ m!^$view->{view_dir}/Default/! && $pkit_view ne 'Default'){
      # check to see if any new files have been uploaded to the $pkit_view dir
      (my $check_filename = $filename) =~ s!^$view->{view_dir}/Default/!$view->{view_dir}/$pkit_view/!;
      if (-f "$check_filename"){
	return 0;
      }
    }
  }

  # record up to date!
  return 1;
}

# here the usage of "component" also includes page
sub _load_component {
  my ($view, $page_id, $component_id, $pkit_view, $component_params) = @_;

  my $template_file = $view->_find_template($pkit_view, $component_id);
  my $template_ref;

  unless($template_file){
    # no template file exists, attempt to generate from XML and XSL files
    # currently only XML::LibXSLT is supported
    $template_ref = $view->{content}->generate_template($page_id, $component_id, $pkit_view, $view->{input_param_object}, $component_params);
  } else {
    open TEMPLATE, "<$template_file" or die "can not read $template_file";
    binmode TEMPLATE;
    local($/) = undef;
    my $template = <TEMPLATE>;
    close TEMPLATE;
    
    # expand PKIT_MACRO tags
    $template =~ s!<\s*PKIT_MACRO$key_value_pattern\s*/?>!$component_params->{uc($+)} || ''!egi;

    $template_ref = \$template;

    my $mtime = (stat(_))[9];
    $view->{include_mtimes}->{$template_file} = $mtime;
  }

  if($view->{can_edit} eq 'yes'){
    Apache::PageKit::Edit::add_component_edit_stubs($view, $page_id, $template_ref, $pkit_view);
  }

  $view->_include_components($page_id,$template_ref,$pkit_view);

  return $template_ref;
}

sub _load_page {
  my ($view, $page_id, $pkit_view) = @_;

  $Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id} = {};

  my $content = $view->{content} ||= Apache::PageKit::Content->new(
						     content_dir => $view->{content_dir},
						     view_dir => $view->{view_dir},
						     default_lang => $view->{default_lang},
                                                     relaxed_parser => $view->{relaxed_parser},
                                                     template_class => $view->{template_class},
                                                     );

  $view->{lang_tmpl} = $content->{lang_tmpl} = {};
  $content->{include_mtimes} = {};
  $view->{component_ids_hash} = {};

  # we add Config.xml to the hash of files to be checked for mtimes,
  # in case default_input_charset or default_output_charset changes!
  (my $config_file = $view->{view_dir}) =~ s!/View$!/Config/Config.xml!;
  my $config_mtime = ( stat($config_file) )[9];
  $view->{include_mtimes} = {$config_file => $config_mtime};

  my $template_file = $view->_find_template($pkit_view, $page_id);
  my $template_ref = $view->_load_component($page_id,$page_id,$pkit_view);

  # remove PKIT_COMMENT parts.
  my $pkit_comment_re = $re_helper{ $view->{relaxed_parser} eq 'yes' ? 'relaxed_parser' : 'std_parser' }->{pkit_comment_re};
  $$template_ref =~ s/$pkit_comment_re//sgi;
  
  #  my $template_file = $view->_find_template($pkit_view, $page_id);
  my ( $lang_tmpl, $skip_xpath_content ) = $content->process_template($page_id, $template_ref);

  # find the right converter for perl < 5.8.0
  # if we skip the xpath content, the string is in $default_input_charset.
  # otherwise it is in utf8 ( from libxml2 )
  my $converter;
  my $default_output_charset = $view->{default_output_charset};
  if ( $skip_xpath_content ) {
    my $default_input_charset = $view->{default_input_charset};
    unless ( lc $default_input_charset eq lc $default_output_charset) {
      eval {
        $converter = Text::Iconv->new( $default_input_charset, $default_output_charset );

lib/Apache/PageKit/View.pm view on Meta::CPAN

    my $record = {
		  exclude_params_set => $exclude_params_set,
		  filename => $template_file,
		  html_template => $tmpl,
		  include_mtimes => $view->{include_mtimes},
		  component_ids => $view->{component_ids},
		  has_form => $has_form,
		 };

    # make directories, if approriate
    (my $dir = $page_id) =~ s!(/)?[^/]*?$!!;

    if($dir){
      File::Path::mkpath("$view->{cache_dir}/$dir");
    }

    my ($extra_param, $param_hash) = ("", "");
    # get a list of requested params in the *.xsl file
    if (my @xml_params = sort keys %{$Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id}}) {
      my $param_obj = $view->{input_param_object};

      for my $xml_param (@xml_params){
        my $value = $param_obj->param($xml_param) || '';
	$extra_param .= "&$xml_param=" . $value;
      }
      $param_hash = Digest::MD5::md5_hex($extra_param);
    }

    # Store record
    Storable::lock_store($record, "$view->{cache_dir}/$page_id.$pkit_view.$lang$param_hash");
  }

  # include mtimes and component_ids are filled in by _include_components
  # and _fill_in_content
  delete $view->{include_mtimes};
  delete $view->{lang_tmpl};
  delete $view->{component_ids_hash};
}

sub _preparse_model_tags {
  use bytes;
  my ( $view, $html_code_ref ) = @_;

  my $exclude_params_set = {};

  # "compile" PageKit templates into HTML::Templates
  if ( $view->{relaxed_parser} eq 'yes' ) {

    # new parser

    # the new parser is a lot more flexible over the old one. it can parse

    # <MODEL_VAR NAME=abc>
    # <MODEL_VAR NAME=abc/>
    # <MODEL_VAR NAME=abc   />
    # <   MODEL_VAR NAME=abc   >
    # <!--   MODEL_VAR NAME=abc   -->
    # <!--MODEL_VAR NAME=abc   -->
    # <!--   MODEL_VAR NAME=abc   /-->

    # all these are valid and expanded. it is slower than the old one but if it works relaible

    if ( $$html_code_ref =~ m%<(!--)?\s*PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*\s*/?(?(1)--)>%i ) {
      warn "PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated.  use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
    }

    # remove tags
    # tags generated by XSLT
    $$html_code_ref =~ s%<(!--)?\s*/(?:MODEL|PKIT)_VAR\s*(?(1)--)>%%sig;

    # translate end to tmpl
    $$html_code_ref =~ s%<(!--)?\s*/(?:MODEL|PKIT)_(LOOP|IF|UNLESS)\s*(?(1)--)>%</TMPL_$2>%sig;

    # XML-style stand-alone tags and other start tags
    $$html_code_ref =~ s%<(!--)?\s*(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)\s*/?(?(1)--)>%<TMPL_$2$3>%sig;

    $$html_code_ref =~
      s^<(!--)?\s*PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?\s*(?(1)--)>(.*?)<(!--)?\s*/PKIT_ERROR(?:FONT|SPAN)\s*(?(8)--)>^
        my $name = $4 || $5 || $6 || $3;
	if ( $name ) {
          qq{<TMPL_VAR NAME="PKIT_ERRORSPAN_BEGIN_$name">$7<TMPL_VAR NAME="PKIT_ERRORSPAN_END_$name">};
	} else {
	  my $text = $7;
	  ( my $errorspan_begin_tag = $view->{errorspan_begin_tag} ) =~ s/<(!--)?\s*PKIT_ERRORSTR\s*(?(1)--)>/$view->{default_errorstr}/gi;
	  $errorspan_begin_tag . $text . $view->{errorspan_end_tag}
	} ^seig;

    $$html_code_ref =~
      s%<(!--)?\s*PKIT_SELFURL$key_value_pattern?\s*/?(?(1)--)>% &process_selfurl_tag($exclude_params_set, $4 || $5 || $6 || $3 ) %seig;

    $$html_code_ref =~ s%<(!--)?\s*/PKIT_(VIEW|IS_ERROR|NOT_ERROR|MESSAGES|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>%     $replace_end_tags{uc($2)}   %seig;
    $$html_code_ref =~ s%<(!--)?\s*PKIT_(MESSAGES|IS_ERROR|NOT_ERROR|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>%           $replace_start_tags{uc($2)} %seig;
    $$html_code_ref =~ s%<(!--)?\s*PKIT_(HOSTNAME|MESSAGE|ERRORSTR|REALURL)\s*/?(?(1)--)>% $replace_start_tags{uc($2)} %seig;

    $$html_code_ref =~
      s^<(!--)?\s*PKIT_VIEW$key_value_pattern\s*/?(?(1)--)>^ sprintf '<TMPL_IF NAME="PKIT_VIEW:%s">', $4 || $5 || $6 || $3; ^sieg; #"

   }
  else {

      if ( $$html_code_ref =~ m%<PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*/?>%i ) {
      warn "PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated.  use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_HAVE_MESSAGES, PKIT_NOT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
    }

    # remove tags
    # tags generated by XSLT
    $$html_code_ref =~ s%</(?:MODEL|PKIT)_VAR>%%sig;

    # translate end to tmpl
    $$html_code_ref =~ s%</(?:MODEL|PKIT)_(LOOP|IF|UNLESS)>%</TMPL_$1>%sig;

    # XML-style stand-alone tags and other start tags
    $$html_code_ref =~ s%<(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)/?>%<TMPL_$1$2>%sig;

    $$html_code_ref =~
      s^<PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?>(.*?)</PKIT_ERROR(?:FONT|SPAN)>^
        my $name = $3 || $4 || $5 || $2;
	if ( $name ) {
          qq{<TMPL_VAR NAME="PKIT_ERRORSPAN_BEGIN_$name">$6<TMPL_VAR NAME="PKIT_ERRORSPAN_END_$name">};
	} else {
	  my $text = $6;

lib/Apache/PageKit/View.pm view on Meta::CPAN

                   exclude_params_set => $exclude_params_set,
                   filename           => $template_file,
                   include_mtimes     => $view->{include_mtimes},
                   component_ids      => $view->{component_ids},
                   has_form           => $has_form,
                   filtered_html      => $tt_parser->parse($$filtered_html)   || die $tt_parser->error(),
    };

    # make directories, if approriate
    ( my $dir = $page_id ) =~ s!(/)?[^/]*?$!!;

    if ($dir) {
      File::Path::mkpath("$view->{cache_dir}/$dir");
    }

    my ( $extra_param, $param_hash ) = ( "", "" );

    # get a list of requested params in the *.xsl file
    if ( my @xml_params = sort keys %{ $Apache::PageKit::Content::PAGE_ID_XSL_PARAMS->{$page_id} } ) {
      my $param_obj = $view->{input_param_object};

      for my $xml_param (@xml_params) {
        my $value = $param_obj->param($xml_param) || '';
        $extra_param .= "&$xml_param=" . $value;
      }
      $param_hash = Digest::MD5::md5_hex($extra_param);
    }

    # Store record
    Storable::lock_store( $record, "$view->{cache_dir}/$page_id.$pkit_view.$lang$param_hash" );
  }

  # include mtimes and component_ids are filled in by _include_components
  # and _fill_in_content
  delete $view->{include_mtimes};
  delete $view->{lang_tmpl};
  delete $view->{component_ids_hash};
}

sub _preparse_model_tags {
  use bytes;
  my ( $view, $html_code_ref ) = @_;

  my $exclude_params_set = {};

  # "compile" PageKit templates into HTML::Templates
  if ( $view->{relaxed_parser} eq 'yes' ) {

    # new parser

    # the new parser is a lot more flexible over the old one. it can parse

    # <MODEL_VAR NAME=abc>
    # <MODEL_VAR NAME=abc/>
    # <MODEL_VAR NAME=abc   />
    # <   MODEL_VAR NAME=abc   >
    # <!--   MODEL_VAR NAME=abc   -->
    # <!--MODEL_VAR NAME=abc   -->
    # <!--   MODEL_VAR NAME=abc   /-->

    # all these are valid and expanded. it is slower than the old one but if it works relaible

    if ( $$html_code_ref =~ m%<(!--)?\s*PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*\s*/?(?(1)--)>%i ) {
      warn
"PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated.  use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
    }

    # remove tags
    # tags generated by XSLT
    $$html_code_ref =~ s%<(!--)?\s*/(?:MODEL|PKIT)_VAR\s*(?(1)--)>%%sig;

    # translate end to tmpl
    $$html_code_ref =~ s~<(!--)?\s*/(?:MODEL|PKIT)_(LOOP|IF|UNLESS)\s*(?(1)--)>~[% END %]~sig;

    # XML-style stand-alone tags and other start tags
    $$html_code_ref =~ s~<(!--)?\s*(?:MODEL|PKIT)_(VAR|LOOP|IF|ELSE|UNLESS)($key_value_pattern*)\s*/?(?(1)--)>~
	  my $type = uc($2);
	  if ( $type eq 'VAR' ) {
	    $type = '';
	  } elsif ( $type eq 'LOOP' ) {
	    $type = 'FOREACH';
	  }
          qq{[\% $type $2 \%]};
	~esig;

    $$html_code_ref =~
      s^<(!--)?\s*PKIT_ERROR(?:FONT|SPAN)$key_value_pattern?\s*(?(1)--)>(.*?)<(!--)?\s*/PKIT_ERROR(?:FONT|SPAN)\s*(?(8)--)>^
        my $name = $4 || $5 || $6 || $3;
	if ( $name ) {
          qq{[\% PKIT_ERRORSPAN_BEGIN_$name \%]${7}[\% PKIT_ERRORSPAN_END_$name \%]};
	} else {
	  my $text = $7;
	  ( my $errorspan_begin_tag = $view->{errorspan_begin_tag} ) =~ s/<(!--)?\s*PKIT_ERRORSTR\s*(?(1)--)>/$view->{default_errorstr}/gi;
	  $errorspan_begin_tag . $text . $view->{errorspan_end_tag};
	} ^seig;

    $$html_code_ref =~
s%<(!--)?\s*PKIT_SELFURL$key_value_pattern?\s*/?(?(1)--)>% &process_selfurl_tag($exclude_params_set, $4 || $5 || $6 || $3 ) %seig;

    $$html_code_ref =~
s%<(!--)?\s*/PKIT_(VIEW|IS_ERROR|NOT_ERROR|MESSAGES|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>%     $replace_end_tags{uc($2)}   %seig;
    $$html_code_ref =~
s%<(!--)?\s*PKIT_(MESSAGES|IS_ERROR|NOT_ERROR|HAVE_MESSAGES|HAVE_NOT_MESSAGES)\s*(?(1)--)>%           $replace_start_tags{uc($2)} %seig;
    $$html_code_ref =~
      s%<(!--)?\s*PKIT_(HOSTNAME|MESSAGE|ERRORSTR|REALURL)\s*/?(?(1)--)>% $replace_start_tags{uc($2)} %seig;

    $$html_code_ref =~
      s^<(!--)?\s*PKIT_VIEW$key_value_pattern\s*/?(?(1)--)>^ sprintf '[%% IF PKIT_VIEW#%s %%]', $4 || $5 || $6 || $3; ^sieg
      ;    #"

  }
  else {

    if ( $$html_code_ref =~ m%<PKIT_(?:VAR|LOOP|IF|UNLESS)(?:$key_value_pattern)*/?>%i ) {
      warn
"PKIT_VAR, PKIT_LOOP, PKIT_IF, and PKIT_UNLESS are depreciated.  use PKIT_HOSTNAME, PKIT_VIEW, PKIT_MESSAGES, PKIT_HAVE_MESSAGES, PKIT_NOT_MESSAGES, PKIT_IS_ERROR, PKIT_NOT_ERROR or PKIT_MESSAGE instead";
    }

    # remove tags
    # tags generated by XSLT
    $$html_code_ref =~ s%</(?:MODEL|PKIT)_VAR>%%sig;

( run in 1.361 second using v1.01-cache-2.11-cpan-97f6503c9c8 )