File Coverage

blib/lib/CGI/MakeItStatic.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

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";
      }
    }
    return unless @str;
    $name = $q->escape($file . '?' . join "&", @str);
  }
  return $attr->{dir} . '/' . $name;
}

sub attr{ my $self = shift; @_ ? $self->{attr}->{shift()} : $self->{attr}}

sub has_static{ my $self = shift; return @_ ? $self->{has_static} = shift : $self->{has_static}; }

sub output{ my($self) = @_; return my $output = $self->{output}; }

sub end{ my($self) = @_; $self->DESTROY; }

sub DESTROY{
  my($self) = @_;
  unless($self->{destroy}++){
    my $s = $self->{stdout};
    if(ref $s){
      my $output = $s;
      die "no output" unless $output;
      open my $out, ">", $self->{static_file} or die "cannot open file to write: " . $self->{static_file};
      seek($out, 0,0);
      print $out $output;
      close $out;
      select($self->{original_select});
      print $output unless $self->attr->{noprint};
      $self->{output} = $output;
    }
  }
}

1;

__END__