Start building URL-Validation related funcitons

Signed-off-by: Mike Rylander <mrylander@gmail.com>

diff --git a/Open-ILS/src/sql/Pg/076.functions.url_verify.sql b/Open-ILS/src/sql/Pg/076.functions.url_verify.sql
new file mode 100644 (file)
index 0000000..056cde3
--- /dev/null
+++ b/Open-ILS/src/sql/Pg/076.functions.url_verify.sql
@@ -0,0 +1,38 @@
+/*
+ * Copyright (C) 2012  Equinox Software, Inc.
+ * Mike Rylander <miker@esilibrary.com>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ */
+
+BEGIN;
+
+CREATE OR REPLACE FUNCTION url_verify.parse_url (url_in TEXT) RETURNS url_verify.url AS $$
+
+use Rose::URI;
+
+my $url_in = shift;
+my $url = Rose::URI->new($url_in);
+
+my %parts = map { $_ => $url->$_ } qw/scheme username password host port path query fragment/;
+
+$parts{full_url} = $url_in;
+($parts{domain} = $parts{host}) =~ s/^[^.]+\.//;
+($parts{tld} = $parts{domain}) =~ s/(?:[^.]+\.)+//;
+($parts{page} = $parts{path}) =~ s#(?:[^/]*/)+##;
+
+return \%parts;
+
+$$ LANGUAGE PLPERLU;
+
+COMMIT;
+

diff --git a/Open-ILS/src/sql/Pg/upgrade/YYYY.functions.url_verify.sql b/Open-ILS/src/sql/Pg/upgrade/YYYY.functions.url_verify.sql
new file mode 100644 (file)
index 0000000..2087794
--- /dev/null
+++ b/Open-ILS/src/sql/Pg/upgrade/YYYY.functions.url_verify.sql
@@ -0,0 +1,22 @@
+BEGIN;
+
+CREATE OR REPLACE FUNCTION url_verify.parse_url (url_in TEXT) RETURNS url_verify.url AS $$
+
+use Rose::URI;
+
+my $url_in = shift;
+my $url = Rose::URI->new($url_in);
+
+my %parts = map { $_ => $url->$_ } qw/scheme username password host port path query fragment/;
+
+$parts{full_url} = $url_in;
+($parts{domain} = $parts{host}) =~ s/^[^.]+\.//;
+($parts{tld} = $parts{domain}) =~ s/(?:[^.]+\.)+//;
+($parts{page} = $parts{path}) =~ s#(?:[^/]*/)+##;
+
+return \%parts;
+
+$$ LANGUAGE PLPERLU;
+
+COMMIT;
+