view release on metacpan or  search on metacpan

lib/Nes.pm  view on Meta::CPAN

  
  sub get {
    my $self  = shift;
    my ($class, $name) = @_;

    return $instance{$class}->{'obj'}{$name} if $name;
    return $instance{$class}->{'obj'}{$class};
   
  }
  
  sub get_obj {
    my $self  = shift;
    my ($class) = @_;

    return $instance{$class} if $class;
    return $self->SUPER::get_obj();
    
  }  
  
}


{

  package nes_cookie;
  use vars qw(@ISA);
  @ISA = qw( Nes );

  sub new {
    my $class = shift;
    my $self  = $class->SUPER::new();

    $self->get_user_cookies();

    return $self;
  }

  sub get_cookies {
    my $self  = shift;

    my @cookies;

    # primero las que borran, para no machacar las que valen
    foreach my $cookie ( keys %{ $self->{'c_set'} } ) {
      push( @cookies, $cookie ) if $cookie =~ /_delete$/;
    }
    foreach my $cookie ( keys %{ $self->{'c_set'} } ) {
      push( @cookies, $cookie ) if $cookie !~ /_delete$/;
    }

    return @cookies;
  }

  sub get {
    my $self  = shift;
    my ( $name, $pass ) = @_;
    
    return if !$self->{'c_get'}{$name};
    $pass = '' if !$pass;

    my $key = $self->{'CFG'}{'private_key'} . $pass;
    require Crypt::CBC;
    my $cipher = Crypt::CBC->new(
      -key    => $key,
      -cipher => 'Blowfish'
    );
    my $text = '';
    eval { $text = $cipher->decrypt_hex( $self->{'c_get'}{$name} ); };

    return $text;
  }

  sub create {
    my $self  = shift;
    my ( $name, $value, $expiration, $path, $domain, $pass ) = @_;
    $pass = '' if !$pass;

    my $expires = &utl::expires($expiration);
    my $key     = $self->{'CFG'}{'private_key'} . $pass;

    require Crypt::CBC;
    my $cipher = Crypt::CBC->new(
      -key    => $key,
      -cipher => 'Blowfish'
    );

    $value = $cipher->encrypt_hex($value);
    $path = '/' if !$path;

    $self->{'c_set'}{$name} = "Set-Cookie: $name=$value; expires=$expires; path=$path; ";
    $self->{'c_set'}{$name} .= "domain=$domain; " if $domain;

    return;
  }

  sub del {
    my $self  = shift;
    my ($name,$path) = @_;
    $path = '/' if !$path;

    my $expires = &utl::expires('1s');
    my $value   = 'deleted';

    $self->{'c_set'}{ $name . '_delete' } = "Set-Cookie: $name=$value; expires=$expires; path=$path; ";

    return;
  }

  sub get_user_cookies {
    my $self  = shift;
    
    return if !$ENV{'HTTP_COOKIE'};

    my @cookies = split( /[;,]\s*/, $ENV{'HTTP_COOKIE'} );
    foreach my $cookie (@cookies) {
      my ( $key, $value ) = split( /=/, $cookie );
      $value = '' if !$value;
      next if $value eq 'deleted';
      $self->{'c_get'}{$key} = $value;
    }
  }
 
  sub out {
    my $self  = shift;

    my $cookies = '';
    foreach my $cookie ( $self->get_cookies() ) {
      $cookies .= $self->{'c_set'}{$cookie}."\n";
    } 
    
    return $cookies;
  }  
   
  sub get_c_get {
    my $self  = shift;

    my @cookies;

    foreach my $cookie ( keys %{ $self->{'c_get'} } ) {
      push( @cookies, $cookie );
    }

    return @cookies;    
  }   
   
}


{ 

  package nes_session;
  use vars qw(@ISA);
  @ISA = qw( nes_cookie );

  sub new {
    my $class = shift;
    my $self  = $class->SUPER::new();
    
    $self->{'session_prefix'} = $self->{'CFG'}{'session_prefix'};
    $self->{'session_ok'}     = 0;
    $self->{'user'}           = '';
    $self->get;
    
    return $self;
  }

  sub get {
    my $self  = shift;
    my ($pass) = @_ || '';

    my $key = $self->{'CFG'}{'private_key'} . $pass;
    $self->{'sess'} = $self->SUPER::get( $self->{'session_prefix'}, $key );
    return if !$self->{'sess'};

    my ( $session_name, $expire, $user, $refuse ) = split( /::/, $self->{'sess'} );

    return if time > $expire;
    return if $session_name ne $self->{'session_prefix'};
    
    $self->{'session_ok'} = 1;
    $self->{'user'} = $user;   
    
    return $user;
  }

  sub create {
    my $self  = shift;
    my ( $user, $expiration, $pass ) = @_;
    $pass = '' if !$pass;

    my $key = $self->{'CFG'}{'private_key'} . $pass;
    my $expire  = time +  utl::expires_time( $expiration );
    my $refuse  = $self->get_key( 10 + int rand 10 );
    my $value   = $self->{'session_prefix'} . '::' . $expire . '::' . $user . '::' . $refuse;
    my $path    = '/';

    $self->{'cookies'}->create( $self->{'session_prefix'}, $value, $expiration, $path,'',$key );

    return;
  }
  
  sub del {
    my $self  = shift;

    return if !$self->{'user'};
    $self->{'cookies'}->del( $self->{'session_prefix'} );
    
    return;
  }  

}


{ # todo, add "<SELET MULTIPLE>" support

  package nes_query;
  use vars qw(@ISA);
  @ISA = qw( Nes );

  sub new {
    my $class = shift;
    my $self  = $class->SUPER::new();
    
    $self->{'q'} = {};
    my $clength = $ENV{'CONTENT_LENGTH'} || 0;
    $self->{'save_buffer'} = 0;

    return $self if !$clength && !$ENV{'QUERY_STRING'};

    require Nes::Minimal;    
    $self->{'save_buffer'} = 1 if $self->{'top_container'}->{'php_wrapper'} && 
                                  $clength > ($self->{'CFG'}{'tmp_upload'}*1024) &&
                                  $self->{'CFG'}{'tmp_upload'};      
    Nes::Minimal::allow_hybrid_post_get(1);
    Nes::Minimal::max_read_size( $self->{'CFG'}{'max_post'}*1024 );
    Nes::Minimal::use_tmp( $self->{'CFG'}{'tmp_upload'}*1024 );
    Nes::Minimal::max_upload( $self->{'CFG'}{'max_upload'}*1024 );
    Nes::Minimal::save_buffer(1) if $self->{'save_buffer'};
    Nes::Minimal::sub_filter( \&utl::no_nes_remove ) if $self->{'top_container'}->{'php_wrapper'}; 
    $self->{'CGI'} = Nes::Minimal->new;
    $self->set_query();
    
    return $self;
  }

  sub set_query {
    my $self  = shift;
 
    foreach my $param ( $self->{'CGI'}->param() ) {
      $self->{'q'}{$param} = $self->{'CGI'}->param($param);
    }