view release on metacpan or  search on metacpan

Generic.pm  view on Meta::CPAN

    }

    sub _encode {
        my ($self, $str) = @_;
        $str = $self->_urlEncode(MIME::Base64::encode_base64($str, ''));
        return $str;
    }

    # taken from CGI::Utils
    sub _urlEncode {
        my ($self, $str) = @_;
        $str =~ s{([^A-Za-z0-9_])}{sprintf("%%%02x", ord($1))}eg;
        return $str;
    }

    # taken from CGI::Utils
    sub _urlDecode {
        my ($self, $str) = @_;
        $str =~ tr/+/ /;
        $str =~ s|%([A-Fa-f0-9]{2})|chr(hex($1))|eg;
        return $str;
    }

    # taken from CGI::Utils
    sub _urlEncodeVars {
        my ($self, $var_hash, $sep) = @_;
        $sep = ';' unless defined $sep;
        my @pairs;
        foreach my $key (keys %$var_hash) {
            my $val = $$var_hash{$key};
            my $ref = ref($val);
            if ($ref eq 'ARRAY' or $ref =~ /=ARRAY/) {
                push @pairs, map { $self->_urlEncode($key) . "=" . $self->_urlEncode($_) } @$val;
            } else {
                push @pairs, $self->_urlEncode($key) . "=" . $self->_urlEncode($val);
            }
        }

        return join($sep, @pairs);
    }

    # taken from CGI::Utils
    sub _addParamsToUrl {
        my ($self, $url, $param_hash) = @_;
        my $sep = ';';
        if ($url =~ /^([^?]+)\?(.*)$/) {
            my $query = $2;
            # if query uses & for separator, then keep it consistent
            if ($query =~ /\&/) {
                $sep = '&';
            }
            $url .= $sep unless $url =~ /\?$/;
        } else {
            $url .= '?';
        }

        $url .= $self->_urlEncodeVars($param_hash, $sep);
        return $url;
    }

    sub _formatDateTime {
        my ($self, $time) = @_;

        $time = time() unless $time;

        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
        $mon += 1;
        $year += 1900;
        my $date = sprintf "%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday,
            $hour, $min, $sec;

        return $date;
    }

    sub _log {
        my ($self, @rest) = @_;
        local(*LOG);
        open(LOG, ">>/tmp/generic_auth_log");
        my $date = $self->_formatDateTime;
        print LOG "$date - ", @rest, "\n";
        close LOG;
    }

}

1;

__END__

=pod

=head1 EXAMPLES

=head1 AUTHOR

 Don Owens <don@owensnet.com>

=head1 COPYRIGHT

 Copyright (c) 2003 Don Owens

 All rights reserved. This program is free software; you can
 redistribute it and/or modify it under the same terms as Perl
 itself.

=head1 VERSION

 0.01

=cut