view release on metacpan or  search on metacpan

lib/CGI/MakeItStatic.pm  view on Meta::CPAN

package CGI::MakeItStatic;

use strict;
use warnings ();
use IO::Scalar ();
use Cwd ();
use Carp ();
use overload '""' => sub { my($self) = @_; return $self->has_static ? 0 : $self };

our $VERSION = '0.03';

$| = 1;

sub check{
  my($class, $q, $attr) = @_;
  my $self = {};
  bless $self => $class;
  $attr ||= {};
  $attr->{dir} or Carp::croak('usage: CGI::MakeItStatic->check($q, {dir => "data_dir"})');
  $attr->{renew_key}   ||= "renew";
  $attr->{keys}        ||= [];
  $attr->{forbid}      ||= sub {return 0};
  $attr->{forbidrenew} ||= sub {return 0};
  $attr->{noprint}     ||= 0;
  $self->{attr}          = $attr;
  $self->{has_static}    = 0;
  $self->{output}        = '';
  return if ref $attr->{forbid} eq 'CODE' and $attr->{forbid}->($q);

  my $static_file = $self->_file_name($q);
  return unless $static_file;

  $self->has_static($self->_check($q, $static_file));
  return $self;
}

sub _check{
  my($self, $q, $static_file) = @_;
  my $attr = $self->attr;
  my $renew = $attr->{forbidrenew}->($q) ? 0 : $q->param($attr->{renew_key});
  if(not $renew and -e $static_file){
    # create new static file
    open my $in, "<", $static_file or die("cannot open file to read: " . $static_file);
    seek($in, 0, 0);
    local $/ = undef;
    my $text = <$in>;
    close $in;
    print $text unless $self->attr->{noprint};
    $self->{output} = $text;
    return 1;
  }else{
    my $data = "";
    $self->{stdout} =  IO::Scalar->new(\$data);
    $self->{static_file} = $static_file;
    $self->{original_select} = select();
    select($self->{stdout});
    return 0;
  }
}

sub _file_name{
  my($self, $q) = @_;
  my $attr = $self->attr;
  my @str;
  $attr->{dir} =~ s|/+|/|;
  my $file = Cwd::abs_path($0);
  my $name;
  if(ref(my $name_code = $attr->{name}) eq 'CODE'){
    $name = $q->escape($name_code->($q, $file));
  }else{
    foreach my $key (sort{$a cmp $b} (@{$attr->{keys}} || $q->param)){
      next if $key eq $attr->{renew_key};
      my @value = $q->param($key);
      foreach my $v (sort {$a cmp $b} @value){
        push @str, "$key=$v";
      }
    }