summaryrefslogtreecommitdiff
path: root/lib/VNDB/Util/Tools.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNDB/Util/Tools.pm')
-rw-r--r--lib/VNDB/Util/Tools.pm145
1 files changed, 145 insertions, 0 deletions
diff --git a/lib/VNDB/Util/Tools.pm b/lib/VNDB/Util/Tools.pm
new file mode 100644
index 00000000..4c873b55
--- /dev/null
+++ b/lib/VNDB/Util/Tools.pm
@@ -0,0 +1,145 @@
+
+package VNDB::Util::Tools;
+
+use strict;
+use warnings;
+use Encode;
+use Exporter 'import';
+
+our $VERSION = $VNDB::VERSION;
+our @EXPORT = qw| FormCheck AddHid SendMail AddDefaultStuff |;
+
+
+# Improved version of ParamsCheck
+# - hashref instead of hash
+# - parameters don't start with form*
+sub FormCheck {
+ my $self = shift;
+ my @ps = @_;
+ my %hash; my @err;
+
+ foreach my $i (0..$#ps) {
+ next if !$ps[$i] || ref($ps[$i]) ne 'HASH';
+ my $k = $ps[$i]{name};
+ $hash{$k} = [ ( $self->ReqParam($k) ) ];
+ $hash{$k}[0] = '' if !defined $hash{$k}[0];
+ foreach my $j (0..$#{$hash{$k}}) {
+ my $val = \$hash{$k}[$j]; my $e = 0;
+ $e = 1 if !$e && $ps[$i]{required} && !$$val && length($$val) < 1 && $$val ne '0';
+ $e = 2 if !$e && $ps[$i]{minlength} && length($$val) < $ps[$i]{minlength};
+ $e = 3 if !$e && $ps[$i]{maxlength} && length($$val) > $ps[$i]{maxlength};
+ if(!$e && $ps[$i]{template}) {
+ my $t = $ps[$i]{template};
+ $hash{$k}[$j] = lc $hash{$k}[$j] if $t eq 'pname';
+ $e = 4 if ($t eq 'mail' && $$val !~ # From regexlib.com, author: Gavin Sharp
+ /^(([A-Za-z0-9]+_+)|([A-Za-z0-9]+\-+)|([A-Za-z0-9]+\.+)|([A-Za-z0-9]+\++))*[A-Za-z0-9]+\@((\w+\-+)|(\w+\.))*\w{1,63}\.[a-zA-Z]{2,6}$/)
+ || ($t eq 'url' && $$val !~ # From regexlib.com, author: M H
+ /^(http|https):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&:\/~\+#]*[\w\-\@?^=%&\/~\+#])?$/)
+ || ($t eq 'pname' && $$val !~ /^[a-z0-9][a-z0-9\-]*$/)
+ || ($t eq 'asciiprint' && $$val !~ /^[\x20-\x7E]*$/)
+ || ($t eq 'int' && $$val !~ /^\-?[0-9]+$/)
+ || ($t eq 'date' && $$val !~ /^[0-9]{4}(-[0-9]{2}(-[0-9]{2})?)?$/);
+ }
+ $e = 5 if !$e && $ps[$i]{enum} && ref($ps[$i]{enum}) eq "ARRAY" && !_inarray($$val, $ps[$i]{enum});
+ if($e) {
+ if($ps[$i]{required}) {
+ my $errc = $ps[$i]{name}.'_'.$e;
+ $errc .= '_'.$ps[$i]{minlength} if $e == 2;
+ $errc .= '_'.$ps[$i]{maxlength} if $e == 3;
+ $errc .= '_'.$ps[$i]{template} if $e == 4;
+ push(@err, $errc);
+ last;
+ } else {
+ $hash{$k}[$j] = exists $ps[$i]{default} ? $ps[$i]{default} : undef;
+ }
+ }
+ last if !$ps[$i]{multi};
+ }
+ $hash{$k} = $hash{$k}[0] if !$ps[$i]{multi};
+ }
+ $hash{_err} = $#err >= 0 ? \@err : 0;
+
+ return \%hash;
+}
+
+sub AddHid {
+ my $fh = $_[0]->FormCheck({ name => 'fh', required => 0, maxlength => 30 })->{fh};
+ $_[1]->{_hid} = { map { $_ => 1 } 'com', 'mod', split /,/, $fh }
+ if $fh;
+}
+
+sub _inarray { # errr... this is from when I didn't know about grep
+ foreach (@{$_[1]}) {
+ (return 1) if $_[0] eq $_;
+ }
+ return 0;
+}
+
+
+sub SendMail {
+ my $self = shift;
+ my $body = shift;
+ my %hs = @_;
+
+ die "No To: specified!\n" if !$hs{To};
+ die "No Subject specified!\n" if !$hs{Subject};
+ $hs{'Content-Type'} ||= 'text/plain; charset=\'UTF-8\'';
+ $hs{From} ||= 'vndb <noreply@vndb.org>';
+ $hs{'X-mailer'} ||= "VNDB $VERSION";
+ $body =~ s/\r?\n/\n/g; # force a '\n'-linebreak
+
+ my $mail = '';
+ foreach (keys %hs) {
+ $hs{$_} =~ s/[\r\n]//g;
+ $mail .= sprintf "%s: %s\n", $_, $hs{$_};
+ }
+ $mail .= sprintf "\n%s", $body;
+
+ if(open(my $mailer, "|/usr/sbin/sendmail -t -f '$hs{From}'")) {
+ print $mailer encode('UTF-8', $mail);
+ die "Error running sendmail ($!)"
+ if !close($mailer);
+ } else {
+ die "Error opening sendail: $!";
+ }
+}
+
+sub AddDefaultStuff {
+ my $self = shift;
+
+ $self->AuthAddTpl;
+ $self->ResAddTpl(st => $self->{static_url});
+
+ $self->ResAddTpl('Stat'.$_, $self->DBTableCount($_))
+ for (qw|users producers vn releases votes|);
+
+ # development shit
+ if($self->{debug}) {
+ my $sqls;
+ for (@{$self->{_DB}->{Queries}}) {
+ $_->[0] =~ s/^\s//g;
+ $sqls .= sprintf("[%6.2fms] %s\n", $_->[1]*1000, $_->[0] || '[undef]');
+ }
+ $self->ResAddTpl(devshit => $sqls);
+ }
+}
+
+1;
+
+__END__
+# from HTTP::Date, small function, so why load an entire module?
+{
+ my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
+ my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+
+ sub time2str {
+ my $time = shift;
+ $time = time unless defined $time;
+ my($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
+ sprintf('%s, %02d %s %04d %02d:%02d:%02d GMT',
+ $DoW[$wday],
+ $mday, $MoY[$mon], $year+1900,
+ $hour, $min, $sec);
+ }
+}
+