view release on metacpan or  search on metacpan

Path.pm  view on Meta::CPAN

sub DESTROY {
  my $self = shift;
}

sub new_session {
  my $self = shift;
  my ($sid, $session_dir, $session_lock_dir) = @_;
  require Apache::Session::File;
  $self->{session} = {};
  tie %{$self->{session}}, 'Apache::Session::File', $sid, {
    Directory     => $session_dir,
    LockDirectory => $session_lock_dir,
  };
  $self->set_sid($self->{session}{_session_id});
}

sub session {
  my $self = shift;
  my $opt = shift;
  unless($self->{session}) {
    eval {
      $self->new_session($self->sid, $self->session_dir, $self->session_lock_dir);
    };
    if($@) {
      if($@ =~ /Object does not exist/i) {
        eval {
          $self->new_session('', $self->session_dir, $self->session_lock_dir);
        };
      }
    }
    die $@ if($@);
  }
  if($opt) {
    my $opt_ref = ref $opt;
    if($opt_ref) {
      if($opt_ref eq 'HASH') {
        foreach(keys %{$opt}) {
          $self->{session}{$_} = $opt->{$_};
        }
      }
    } else {
      die "I got not a ref on session opt";
    }
  }
  return $self->{session};
}

sub sid_cookie_name {
  my $self = shift;
  return $self->my_content . "_sid";
}

sub set_cookie {
  my $self = shift;
  my ($cookie_name, $cookie_value) = @_;
  my $new_cookie = CGI::cookie
    (-name  => $cookie_name,
     -value => $cookie_value,
     );
  if (exists $ENV{CONTENT_TYPED}) {
    print qq{<meta http-equiv="Set-Cookie" content="$new_cookie">\n};
  } else {
    print "Set-Cookie: $new_cookie\n";
  }
  return;
}

sub set_sid {
  my $self = shift;
  my $sid = shift;
  $self->set_cookie($self->sid_cookie_name, $sid);
}

sub sid {
  my $self = shift;
  return $self->cookies->{$self->sid_cookie_name} || '';
}

sub merge_in_args {
  my $self = shift;
  my %PASSED_ARGS = (ref $_[0] eq 'HASH') ? %{$_[0]} : @_;
  foreach my $passed_arg (keys %PASSED_ARGS) {
    if(ref $PASSED_ARGS{$passed_arg} && ref $PASSED_ARGS{$passed_arg} eq 'HASH') {
      foreach my $key (keys %{$PASSED_ARGS{$passed_arg}}) {
        $self->{$passed_arg}{$key} = $PASSED_ARGS{$passed_arg}{$key};
      }
    } else {
      $self->{$passed_arg} = $PASSED_ARGS{$passed_arg}
    }
  }
}

### morph methods

sub morph_path {
  my $self = shift;
  my $my_module = shift || $self->my_module;

  # morph to my_module
  if($my_module) {
    $self->morph($my_module, 1);
  }

}

sub morph_step {
  my $self = shift;

  my $step = shift;
  # going to morph based on my_module

  my $full_step = $self->my_module . "::$step";

  # morph to something like CGI::Path::Skel::page_one
  # the 1 turns on the -e check
  $self->morph($full_step, 1);
  
}

sub morph {
  my $self = shift;

  my $starting_ref = ref $self;