From c812239d96a7266d0f079c4fcf504f343ffdd9ea Mon Sep 17 00:00:00 2001 From: "Kyle J. McKay" Date: Thu, 1 Aug 2013 20:47:13 -0700 Subject: [PATCH] Util.pm: add url_base function to go with url_path The url_path function returns only the path (and anything following) portion of a URL. Add a new url_base function that returns only the base of the URL excluding the path (and anything following). Given a URL in $url, then 'url_base($url).url_path($url) eq $url' is always true. --- Girocco/Util.pm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/Girocco/Util.pm b/Girocco/Util.pm index 168d0ed..bf9791f 100644 --- a/Girocco/Util.pm +++ b/Girocco/Util.pm @@ -9,10 +9,10 @@ use Time::Local; BEGIN { use base qw(Exporter); our @EXPORT = qw(scrypt jailed_file - lock_file unlock_file valid_tag + lock_file unlock_file valid_tag rand_adjust filedb_atomic_append filedb_atomic_edit filedb_grep filedb_atomic_grep valid_email valid_email_multi - valid_repo_url valid_web_url url_path rand_adjust + valid_repo_url valid_web_url url_base url_path projects_html_list parse_rfc2822_date parse_any_date); } @@ -185,6 +185,19 @@ sub valid_tag { return length($_) <= 32 ? 1 : 0; } +# If the passed in argument looks like a URL, return only the stuff up through +# the host:port part otherwise return the entire argument. +sub url_base { + my $url = shift || ''; + # See RFC 3968 + $url = $1.$2.$3.$4 if $url =~ m,^( [A-Za-z][A-Za-z0-9+.-]*: ) # scheme + ( // ) # // separator + ((?:[^\@]+\@)?) # optional userinfo + ( [^/?#]+ ) # host and port + (?:[/?#].*)?$,x; # path and optional query string and/or anchor + return $url; +} + # If the passed in argument looks like a URL, return only the stuff following # the host:port part otherwise return the entire argument. sub url_path { -- 2.11.4.GIT