binmode results from the CPAN

binmode

Apache-PageKit

view release on metacpan or search on metacpan


	For more details on migration, see migration/README
1.18
 	- Allow testsuit to catch up with Changes in Apache::Test.
 		POST's can be redirected on the fly. 
		Otherwise the tests 05, 06 and 07 fail.
		( Boris Zentner )

1.17
	- Fix: a new typo in Makefile.PL
		-+binmode $template_fh, ':encoding($default_input_charset)';
		++binmode $template_fh, ":encoding($default_input_charset)";
		( Boris Zentner )
1.16
        ! The param method returns a empty list in list context if 
                the param was not defined. Older PageKits returned undef
                ( Boris Zentner )
        - Fix: add missing : in binmode $fh, ":encoding(...)";
                ( Boris Zentner )
        - Fix: typo in scripts/pkit_rename_app.pl ( Boris Zentner )
1.15
	- Add: request_class parameter just for the case, that you like 
		another class or subclass do what Apache::Request do for you.
		Defaults to Apache::Request::PageKit ( Boris Zentner )
	- Fix: conversion error if the tmpl file's encoding is != utf8 and no
		content_var's are used. affects only perl < 5.8.0
		( Boris Zentner )
	- Add: Basic testsuite ( Boris Zentner )

Makefile.PL view on Meta::CPAN

 
 sub _rel2abs {
diff -Nur a/lib/Apache/PageKit/Edit.pm b/lib/Apache/PageKit/Edit.pm
--- a/lib/Apache/PageKit/Edit.pm	2005-01-01 20:42:57.117134856 +0100
+++ b/lib/Apache/PageKit/Edit.pm	2005-01-01 19:33:16.000000000 +0100
@@ -44,14 +44,15 @@
 
   $model->output( read_only => 1 ) if ( ! -w $file );
 
-  open FILE, "$file" or die $!;
-  binmode FILE;
-  local $/ = undef;
+  my $default_input_charset = $model->{pkit_pk}->{view}->{default_input_charset};
+  open my $fh, $file or die $!;
+  binmode $fh, ":encoding($default_input_charset)";
+  local $/;
 
 # we need to escape HTML tags to avoid </textarea>
 # my $content = Apache::Util::escape_html(<PAGE> || "");
-  my $content = <FILE>;
-  close FILE;
+  my $content = <$fh>;
+  close $fh;
 
   # we need to escape all & chars so that for example &nbsp; is
   # &nbsp; and not ' ' 
@@ -76,10 +77,11 @@
   my $pkit_done = $model->input('pkit_done');
   my $content = $model->input('content');
 
-  open FILE, ">$file" or die $!;
-  binmode FILE;
-  print FILE $content;
-  close FILE;
+  my $default_input_charset = $model->{pkit_pk}->{view}->{default_input_charset};
+  open my $fh, ">$file" or die $!;
+  binmode $fh, ":encoding($default_input_charset)";
+  print $fh $content;
+  close $fh;
 
   if($pkit_done){
     $model->pkit_redirect($pkit_done);
diff -Nur a/lib/Apache/PageKit/Model.pm b/lib/Apache/PageKit/Model.pm
--- a/lib/Apache/PageKit/Model.pm	2005-01-01 20:42:57.138131664 +0100
+++ b/lib/Apache/PageKit/Model.pm	2005-01-01 19:33:16.000000000 +0100
@@ -204,15 +204,8 @@
   # translate from default_input_charset to default_output_charset if needed

Makefile.PL view on Meta::CPAN

 			  );
+      Encode::_utf8_on($output);
     }
   }
   if($view->{can_edit} eq 'yes'){
@@ -206,15 +208,15 @@
 
   # is the cache entry valid or changed on disc?
   if(-f "$gzipped_filename"){
-    open FH, "<$gzipped_filename" or return undef;
-    binmode FH;
+    open my $fh, "<$gzipped_filename" or return undef;
+    binmode $fh;
     # read mtime from first line
     chomp($gzip_mtime = <FH>);
 
     # read rest of gzipped content
-    local $/ = undef;
-    $gzipped_content = <FH>;
-    close FH;
+    local $/;
+    $gzipped_content = <$fh>;
+    close $fh;
     if($view->{reload} ne 'no'){
       # is the cache entry valid or changed on disc?
       my $mtime = ( stat($filename) )[9];
@@ -285,11 +287,11 @@
 # creates gzipped file
 sub _create_static_zip {
   my ($view, $filename, $gzipped_filename) = @_;
-  local $/ = undef;
-  open FH, "<$filename" or return undef;
-  binmode FH;
-  my $content = <FH>;
-  close FH;
+  local $/;
+  open my $fh, "<$filename" or return undef;
+  binmode $fh;
+  my $content = <$fh>;
+  close $fh;
 
   $view->_html_clean(\$content);
 
@@ -301,11 +303,11 @@
 
   if ($gzipped_content) {
     my $mtime = (stat($filename))[9];
-    if ( open GZIP, ">$gzipped_filename" ) {
-      binmode GZIP;
-      print GZIP "$mtime\n";
-      print GZIP $gzipped_content;
-      close GZIP;
+    if ( open my $gzip_fh, ">$gzipped_filename" ) {
+      binmode $gzip_fh;
+      print $gzip_fh "$mtime\n";
+      print $gzip_fh $gzipped_content;
+      close $gzip_fh;
     } else {
       warn "can not create gzip cache file $view->{cache_dir}/$gzipped_filename: $!";
     }
@@ -457,12 +459,13 @@
     # 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;
-    
+      open my $template_fh, "<$template_file" or die "can not read $template_file";
+      my $default_input_charset = $view->{default_input_charset};
+      binmode $template_fh, ":encoding($default_input_charset)";
+      local $/;
+      my $template = <$template_fh>;
+      close $template_fh;
+
     # expand PKIT_MACRO tags
     $template =~ s!<\s*PKIT_MACRO$key_value_pattern\s*/?>!$component_params->{uc($+)} || ''!egi;
 
@@ -510,38 +513,9 @@
   # remove PKIT_COMMENT parts.
   my $pkit_comment_re = $re_helper{ $view->{relaxed_parser} eq 'yes' ? 'relaxed_parser' : 'std_parser' }->{pkit_comment_re};

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

  $model_base_class->pkit_startup($pkit_root, $server, $config)
    if $model_base_class->can('pkit_startup');
}

# object oriented method call, see Eagle p.65
sub handler ($$){
  my $class = shift;

  my ($pk, $model, $status_code);

  binmode STDOUT;
  $| = 1;

  eval {
    $pk = $class->new;
    $model = $pk->{model};
    my $apr = $pk->{apr};
    my $view = $pk->{view};
    my $config = $pk->{config};
    $status_code = $pk->prepare_page;
    my $use_template = $config->get_page_attr($pk->{page_id},'use_template') || 'yes' if ($status_code eq OK);

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

    
    my $fop_command = $config->get_server_attr('fop_command') 
      || $config->get_global_attr('fop_command');

    if ( $fop_command ) {
      # write output_media to file, using process number of Apache child process
      my $view_cache_dir = $view->{cache_dir};
      my $fo_file = "$view_cache_dir/$$.fo";
      my $pdf_file = "$view_cache_dir/$$.pdf";
      open FO_TEMPLATE, ">$fo_file" or die "can't open file: $fo_file ($!)";
      binmode FO_TEMPLATE;
      print FO_TEMPLATE $$output_ref;
      close FO_TEMPLATE;
      
      #   my $error_message = `$fop_command $fo_file $pdf_file 2>&1 1>/dev/null`;
      my $error_message = `$fop_command $fo_file $pdf_file 2>&1`;

      ## the recommended fop converter has no usefull error messages.
      ## the errormoessages go also to STDOUT
      ## and the returncode is always 0
      unless ($error_message =~ /^\[ERROR\]:/m){
        local $/;
        open PDF_OUTPUT, "<$pdf_file" or die "can't open file: $pdf_file ($!)";
        binmode PDF_OUTPUT;
        $$output_ref = <PDF_OUTPUT>;
        close PDF_OUTPUT;
      } 
      else {
        die "Error processing template with Apache XML FOP: $error_message";
      }
    }
    $apr->content_type($output_media);
  } else {
    # just set content_type

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

  $page_attr->{$config_dir}    = {};
  $user_attr->{$config_dir}    = {};
  $view_attr->{$config_dir}    = {};
  $uri_match->{$config_dir}    = {};

  my $parser = XML::LibXML->new;

  # this open close hack is needed. oherwise XML::LibXML sometimes likes to open with the
  # handlers we set in Content.pm! So we use parse_fh instead of parse_file.
  open CFH, "<$config_dir/Config.xml" or die $!;
  binmode CFH;
  my $dom  = $parser->parse_fh(\*CFH);
  close CFH;

  my $root = $dom->getDocumentElement;

  #search for the following nodes ...
  my %subs = (
    GLOBAL             => \&GLOBAL,
    USER               => \&USER,
    'SERVERS/SERVER'   => \&SERVER,

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


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;
}

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


  my $file = $model->input('file') || die "No input filename!";

  $model->output(file => $file);

  $file = _build_path( $model->pkit_root, $file ) || die "Illegal input chars ($file)" ;

  $model->output( read_only => 1 ) if ( ! -w $file );

  open FILE, "$file" or die $!;
  binmode FILE;
  local $/ = undef;

# we need to escape HTML tags to avoid </textarea>
# my $content = Apache::Util::escape_html(<PAGE> || "");
  my $content = <FILE>;
  close FILE;

  # we need to escape all & chars so that for example &nbsp; is
  # &nbsp; and not ' ' 
  #<textarea> holds #PCDATA

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

    return;
  }

  my $file = $model->input('file') || die "No input filename!";
  $file = _build_path( $model->pkit_root, $file ) || die "Illegal input chars ($file)" ;

  my $pkit_done = $model->input('pkit_done');
  my $content = $model->input('content');

  open FILE, ">$file" or die $!;
  binmode FILE;
  print FILE $content;
  close FILE;

  if($pkit_done){
    $model->pkit_redirect($pkit_done);
  }
}

sub add_edit_links {
  my ($view, $record, $output_ref) = @_;

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

  }
  $apr->send_http_header if $apr->is_main;
  unless ($apr->header_only) {
    # NOT a head request, send the data
    if ( $type eq 'SCALAR' ) {
      $apr->print($$ref_or_fname);
    } elsif ( $type eq 'GLOB' ) {
      $apr->send_fd($ref_or_fname);
    } else {
      if ( open SENDFH, "<$ref_or_fname" ) {
        binmode SENDFH;
        $apr->send_fd(\*SENDFH);
        close SENDFH;
      }
      else {
        warn "can not open file: $ref_or_fname ($!)";
        return NOT_FOUND;
      }
    }
  }
  return DONE;

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

sub get_static_gzip {
  my ($view, $filename) = @_;
  my ($gzip_mtime, $gzipped_content);

  (my $relative_filename = $filename) =~ s!^$view->{view_dir}/!!;
  my $gzipped_filename = "$view->{cache_dir}/$relative_filename.gz";

  # is the cache entry valid or changed on disc?
  if(-f "$gzipped_filename"){
    open FH, "<$gzipped_filename" or return undef;
    binmode FH;
    # read mtime from first line
    chomp($gzip_mtime = <FH>);

    # read rest of gzipped content
    local $/ = undef;
    $gzipped_content = <FH>;
    close FH;
    if($view->{reload} ne 'no'){
      # is the cache entry valid or changed on disc?
      my $mtime = ( stat($filename) )[9];

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

  return 1 if $view->_find_template($pkit_view,$page_id);
}

# private methods

# creates gzipped file
sub _create_static_zip {
  my ($view, $filename, $gzipped_filename) = @_;
  local $/ = undef;
  open FH, "<$filename" or return undef;
  binmode FH;
  my $content = <FH>;
  close FH;

  $view->_html_clean(\$content);

  my $gzipped_content = Compress::Zlib::memGzip($content);

  (my $gzipped_dir = $gzipped_filename) =~ s!(/)?[^/]*?$!!;

  File::Path::mkpath("$gzipped_dir");

  if ($gzipped_content) {
    my $mtime = (stat($filename))[9];
    if ( open GZIP, ">$gzipped_filename" ) {
      binmode GZIP;
      print GZIP "$mtime\n";
      print GZIP $gzipped_content;
      close GZIP;
    } else {
      warn "can not create gzip cache file $view->{cache_dir}/$gzipped_filename: $!";
    }
    return $gzipped_content;
  }
  return undef;
}

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


  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];

( run in 0.412 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )