view release on metacpan or  search on metacpan

lib/Apache2/PageKit/Content.pm  view on Meta::CPAN

    my $file_mtimes = $xpt->file_mtimes;
    while (my ($k, $v) = each %$file_mtimes){
      # $v (mtime) can be undef in case where the content came from
      # xpath document function. This is not changed in HTML::Template::XPath
      # since otherwise the H:T:X try to put the file into his mtimes hash
      # over and over
      $content->{include_mtimes}->{$k} = $v if $v;
    }
  } else {
    $lang_tmpl->{$content->{default_lang}} = $template_ref;
  }
  return $lang_tmpl;
}

sub _rel2abs {
  my ($rel_uri) = @_;
  if($rel_uri =~ m!\.xml!){
    my $content_dir = $CONTENT->{content_dir};
    if($rel_uri =~ m!^/!){
      return "$content_dir$rel_uri";
    } else {
      # return relative to component_id_dir
      my $abs_uri = "$content_dir/$COMPONENT_ID_DIR$rel_uri";
      while ($abs_uri =~ s![^/]*/\.\./!!) {};
      return $abs_uri;
    }
  } elsif($rel_uri =~ m!\.xsl!){
    my $view_dir = $CONTENT->{view_dir};
    my $stylesheet_file;
    if($rel_uri =~ m!^/!){
      $stylesheet_file = "$view_dir/$PKIT_VIEW$rel_uri";
      unless( -f $stylesheet_file){
	$stylesheet_file = "$view_dir/Default$rel_uri";
      }
    } else {
      # return relative to component_id_dir
      $stylesheet_file = "$view_dir/$PKIT_VIEW/$COMPONENT_ID_DIR$rel_uri";
      while ($stylesheet_file =~ s![^/]*/\.\./!!) {};
      unless( -f $stylesheet_file){
	$stylesheet_file = "$view_dir/Default/$COMPONENT_ID_DIR$rel_uri";
	while ($stylesheet_file =~ s![^/]*/\.\./!!) {};
      }
    }
    die "Stylesheet $stylesheet_file doesn't exist" unless ( -f $stylesheet_file );
    return $stylesheet_file;
  } else {
    die "$rel_uri does not end in .xml or .xsl.  All Content XML files must have
     xml suffix and all View XSLT files must have xsl suffix.";
  }
}

sub match_uri {
  my $uri = shift;
  return $uri !~ /(^\w+:)|(catalog$)/;
}

sub open_uri {
  my $uri = shift;
  my $abs_uri = _rel2abs($uri);
  open my $xml, "$abs_uri" or die "XML file $abs_uri doesn't exist";
  binmode $xml;
  local($/) = undef;
  my $xml_str = <$xml>;
  close $xml;
  my $mtime = (stat(_))[9];
  $INCLUDE_MTIMES->{$abs_uri} = $mtime;

  # we avoid to use any XML::LibXML parser inside the callbackroutines.

  return $xml_str;
}

sub read_uri {
  return substr($_[0], 0, $_[1], "");
}

sub close_uri {}

1;