package Mojolicious::Plugin::P;
use Mojo::Base 'Mojolicious::Plugin';

use strict;
use warnings;
use Digest::MD5 qw(md5_base64 md5_hex);
use Encode qw(encode_utf8);
use DateTime qw();
use Crypt::CBC;
use Compress::Zlib;
use MIME::Base64;
use File::Copy qw(copy);
use Mojo::Util qw(slurp);

sub register {

	my ($self, $app, $config) = @_;

    $app->helper(mypluginhelper => sub { 
    	return 'I am your helper and I live in a plugin!'; 
    });

    # returns a sort of UID
    # - if $hex flag set, will match /^[0-9a-f]{32}$/i
    # - if not set, will return a fake md5_base64 matching /^[A-Za-z-0-9]+$/i 
    #   having at most 22 chars (chars '+' and '/' removed, to be able to use as a filename) 
    $app->helper(randomname => sub {
		my ($self, $hex) = @_;
    	my $name = lc(($hex ? md5_hex(rand) : md5_base64(rand)));
	    $name =~ s/\+//g;
	    $name =~ s/\///g;
    	return $name; 
    });

    $app->helper(uploadpost => sub {
		my ($self, $uploaddir, $file2uploadparamname, $overwriteok, $backupdays2keep, $minbackupfiles2keep, $responsesuccess, $responsefailure, $responseexistingalready) = @_;
	    my $file2upload = $self->req->upload($file2uploadparamname || 'file'); # a Mojo::Upload object
	    if(!$file2upload){
	        return ($responsefailure || 'NOK');
	    }
	    else{
#	    	my $msg;
	    	my $fname = $file2upload->filename;
	        my $uploadedfilename = $uploaddir . '/' . $fname;
	        my $overwrite = $overwriteok || $self->param('overwrite');
	        if(!$overwrite && -f $uploadedfilename){
	            return ($responseexistingalready || 'NOKOVER');
	        }else{
	        	if($backupdays2keep>=0 && -f $uploadedfilename){
	        		my $backupdir = $self->tmpdir($uploaddir,'back');
    				copy($uploadedfilename, $backupdir . '/' . $self->randomname . '~' . $fname);
					# deletes all backed up files that are too old
					my $homedir = $app->home->to_string;
					my $relbackupdir = $backupdir;
					$relbackupdir =~ s/^$homedir\///;
				  	my $filesref =  $self->app->home->list_files($relbackupdir);
				  	$fname = quotemeta('~' . $fname);
					my @backedupfiles;
					foreach(@{$filesref}){
						if(m/$fname$/){
							push @backedupfiles, $backupdir . '/' . $_;
						}
					}
#					$msg = '';
					# sorting the files by increasing "last modified date"
					my @sortedbackedupfiles = sort {(stat($a))[9] <=> (stat($b))[9]} @backedupfiles;
					my $lastmodiftimesec;
					my $nowtime = time;
					foreach my $backedupfile (@sortedbackedupfiles){
						# $msg .= $backedupfile . " - " . (stat($backedupfile))[9] . " - ";
						if(!defined($minbackupfiles2keep) || $minbackupfiles2keep--<=0){
							$lastmodiftimesec = (stat($backedupfile))[9];
							if($nowtime - $lastmodiftimesec > $backupdays2keep * 86400){
								unlink($backedupfile);
#								$msg .= "UNLINK";
							}
							# else{
							# 	my $days = ($nowtime - $lastmodiftimesec)/86400.0;
							# 	$msg .= "KEEP ($days days)";							
							# }
						}
						# else {
						# 	$msg .= "KEEP ($minbackupfiles2keep files)";							
						# }
						# $msg .= "\n";							
					}
	        	}
	            $file2upload->move_to($uploadedfilename);
	            return ($responsesuccess || 'OK');#. "\n$msg"
	        }
	    }
    });

	# overwrites a file with its MESHL format: encrypted gzip-compressed and base64-encoded equivalent
	# better backup original file ;)
	# returns undef if error or % compression ratio if OK
    $app->helper(encryptfile => sub {
		my ($self, $filename, $key) = @_;
		return unless -f $filename;
		my $originalsize = -s $filename;
	    open(IN, "<", $filename) or return;
	    binmode IN;

	    my ($zip, $outbuf, $buf, $zstatus);

	    # in-memory zipping
		open(OUT, ">", \$outbuf) or return;
		binmode OUT;
		$zip = deflateInit(-Level => Z_DEFAULT_COMPRESSION) or return;
		while(read(IN, $buf, 4096)){
			($buf, $zstatus) = $zip->deflate($buf);
			$zstatus == Z_OK or return;
			print OUT $buf;
		}
		close IN;
		($buf, $zstatus) = $zip->flush();
		$zstatus == Z_OK or return;
		print OUT $buf;
		close OUT;

		# in-memory Blowfish ciphering
		open(IN, "<", \$outbuf) or return;
		binmode IN;
	    open(OUT, ">", \$zstatus) or return;
	    binmode OUT;
		if(!$key) {
			$key = $config->{site}->{cryptkey};
		}
		my $cipher = Crypt::CBC->new(-key => $key, -cipher => 'Blowfish_PP');
	    $cipher->start('encrypting');
	    while(read(IN, $buf, 1024)){
	      $buf = $cipher->crypt($buf);
	      print OUT $buf;
	    }
	    close IN;
	    $buf = $cipher->finish;
	    print OUT $buf;
	    close OUT;

	    # base64 encoding and rotting
		$zstatus = encode_base64($zstatus,'');
		$zstatus =~ tr/a-zA-Z/n-za-mN-ZA-M/; # un ptit rot de base
      	$zstatus =~ s/=+$//; # removes trailing = chars
		$zstatus = 'MESHL' . $zstatus;

		# overwrites input file with output file
	    open(OUT, ">", $filename) or return;
	    binmode OUT;
	    print OUT $zstatus;
	    close OUT;
	    return int(((-s $filename) * 100.0)/$originalsize + 0.5);
    });

	# overwrites a MESHL file with its decoded content, with automatic detection/decompression/decoding of gzip compression and base64 encoding
	# returns undef if error or % decompression ratio if OK
	$app->helper(decryptfile => sub {
		my ($self, $filename, $key) = @_;
		return unless -f $filename;
		my $originalsize = -s $filename;
	    my ($inbuf, $outbuf, $buf, $zstatus);
	    open(IN, "<", $filename) or return;
	    binmode IN;
	    $inbuf = do { local $/;  <IN> };
	    close IN;
	    $inbuf =~ s/^MESHL//;
	    open(IN, "<", \$inbuf) or return;
	    binmode IN;
	    read(IN, $buf, 1024);
	    if($buf =~ m/^[A-Za-z0-9+\/=]+$/){ # is data base64 encoded?
	        close IN;
	        $inbuf .= '=' x (length($inbuf) % 3); # adds back the missing = chars
	        $inbuf =~ tr/a-zA-Z/n-za-mN-ZA-M/; # un ptit rot debase
	        $inbuf = decode_base64($inbuf);
	        open(IN, "<", \$inbuf) or return;
	        binmode IN;
	    }
	    else{
	      seek(IN, 0, 0);
	    }   
	    # there will possibly be a second IO layer in order to unzip so deciphers in memory
	    open(OUT, ">", \$outbuf) or return;
	    binmode OUT;
		if(!$key) {
			$key = $config->{site}->{cryptkey};
		}
		my $cipher = Crypt::CBC->new(-key => $key, -cipher => 'Blowfish_PP');
	    $cipher->start('decrypting');
	    while(read(IN, $buf, 1024)){
	      print OUT $cipher->crypt($buf);
	    }
	    print OUT $cipher->finish;
	    close OUT;
	    close IN;
	    open(OUT, ">", $filename) or return;
	    binmode OUT;
	    my $unzipped = uncompress($outbuf); # automatic detection and gzip decompression when needed...
	    print OUT $unzipped || $outbuf;
	    close OUT;
	    return int(((-s $filename) * 100.0)/$originalsize + 0.5);
	});

    $app->helper(encrypt => sub {
		my ($self, $string, $key) = @_;
		if(!$key) {
			$key = $config->{site}->{cryptkey};
		}
		my $cipher = Crypt::CBC->new(-key => $key, -cipher => 'Blowfish_PP');
		return $cipher->encrypt_hex($string);
    });

    $app->helper(decrypt => sub {
		my ($self, $string, $key) = @_;
		if(!$key) {
			$key = $config->{site}->{cryptkey};
		}
		my $cipher = Crypt::CBC->new(-key => $key, -cipher => 'Blowfish_PP');
		return $cipher->decrypt_hex($string);
    });

    # (basic) file type check/guess, reading file bytes
    $app->helper(checkfiletype => sub {
		my $self = shift;
		my ($extensions, $bytes) = @_;
		
		my $type = undef;

	    if ($bytes =~ /^GIF/) {
	        $type = "gif";
	    } elsif ($bytes =~ /PNG/) {
	        $type = "png";

	    } elsif(unpack("n",substr($bytes,0,2)) == 0xFFD8){
	        $type = "jpg";
	    }

	    my $in = 0;
	    for my $t (@{$extensions}){
	        if($type eq $t){
	            $in = 1; last;
	        }
	    }
	    if(!$type || !$in) {
	    	return undef;
	    }
    	return $type; 
    });

    # extract img dimensions straight from file bytes
    $app->helper(imgsize => sub {
		my $self = shift;
		my ($type, $bytes) = @_;
		my ($width, $height) = ();
		if($type eq 'gif'){
			($width, $height) = unpack( "SS", $1 ) if $bytes =~ /^GIF8..(....)/s;
		}
		elsif($type eq 'png'){
			($width, $height) = unpack( "NN", $1 ) if $bytes =~ /IHDR(........)/s;
		}
		elsif($type eq 'jpg'){
			my $MARKER = 0xFF; # section marker
		    my $SIZE_FIRST = 0xC0; # range of segment identifier codes
		    my $SIZE_LAST = 0xC3; # that hold size info
		    my $pos = 0;
		    getbytes($pos, $bytes, 2) or return; # skips header ID
		    $pos += 2;
		    while (1) {
		        my ($marker, $code, $length) = unpack 'C C n' , getbytes($pos, $bytes, 4);
			    $pos += 4;
		        ($marker || '') eq $MARKER or return; # checks segment validity
		        last if $SIZE_FIRST <= $code && $code <= $SIZE_LAST;
		        getbytes($pos, $bytes, $length - 2) or return; # skips over data
		        $pos += $length - 2;
		    }
		    ($width, $height) = unpack 'v v' , reverse getbytes($pos,$bytes,5);  # Return width and height. 
		}
		return ($width, $height);
    });

	$app->helper(strremovepath => sub {
		my $self = shift;
		my $filename = shift;
		$filename =~ s/^.*?[\\\/]?([^\\\/]+)$/$1/; # removes path from file name
		return $filename;
	});

	$app->helper(strdbdate2humandate => sub {
		my $self = shift;
		my $date = shift;
		$date =~ s/^(\d\d\d\d)(\d\d)(\d\d) \d\d:\d\d:\d\d$/$1/; # removes path from file name
		return "$3/$2/$1";
	});
	
    # generates and/or returns a/the unique random session id (prefixed by the client IP)
    # access helper with $self->sessionid and NOT app->sessionid!!!
    $app->helper(idsession => sub {
		my $self = shift;
		my ($expiresseconds) = @_;
	    if(!$self->session->{id}){
	        my $id = $self->tx->remote_address . '~' . lc(md5_base64(rand));
	        $id =~ s/\+//g;
	        $id =~ s/\///g;
	        $id =~ s/ //g;
	        $id =~ s/://g;
	        $self->session(id => $id);
	    }
		if(defined($expiresseconds)){
			if($expiresseconds==0){
				$self->session(expires => 1); # forces immediate session expiration
			}
			else{
				$self->session(expires => time + $expiresseconds);
			}
		}
	    return $self->session->{id};
    });

    # gets an IP and session specific directory, created if needed, sitting on top of relative path $reldir
    $app->helper(sessiondir => sub {
		my $self = shift;
		my ($reldir) = @_;
		if(!$reldir){
			$reldir = $app->home->to_string;
		}
		my $directory = $reldir . '/' . $self->idsession;
		mkdir($directory) unless(-d $directory);
		return $directory;
	});

    # gets a year/month directory, eg. /2013/04, "a la WordPress", created if needed, sitting on top of relative path $reldir
    $app->helper(yearmonthdir => sub {
		my $self = shift;
		my ($reldir) = @_;
		if(!$reldir){
			$reldir = $app->home->to_string;
		}

		my ($year, $month) = (DateTime->now->strftime('%Y'), DateTime->now->strftime('%m'));

		my $directory = $reldir . '/' . $year;
		mkdir($directory) unless(-d $directory);
		$directory .= '/' . $month;
		mkdir($directory) unless(-d $directory);
		return $directory;
	});

    # gets a overridable temporary? directory, created if needed
    $app->helper(tmpdir => sub {
		my $self = shift;
		my ($reldir,$dirname) = @_;
		if(!$reldir){
			$reldir = $app->home->to_string;
		}
		if(!$dirname) {
			$dirname = 'tmp';
		}
		my $directory = $reldir . '/' . $dirname;
		mkdir($directory) unless(-d $directory);
		return $directory;
	});

    $app->helper(logdbg => sub { 
		my ($self, $message) = @_;
		$self->app->log->debug($message);
    });

    # generates a unique application identifier by slurping the whole script file and computing its MD5 sum...
    # => clever way of generating a unique key for app->secret 
    # access helper with app->appuid
    $app->helper(appuid => sub { 
	    my $scriptstring = undef;
	    {
	      local $/=undef;
	      open SCRIPT, "<$0";
	      binmode SCRIPT;
	      $scriptstring = <SCRIPT>;
	      close SCRIPT;
	    }
	    if($scriptstring){
	    	return md5_hex(encode_utf8($scriptstring));
	    }
	    else{
	    	return undef;
	    }
    });

    $app->helper(getimages => sub {
		my $self = shift;
  		my ($getthumbs, $seriesnames, $imagesfolder) = @_;

  		my $imagefolderabbreviated = '';
  		my $pathabbreviated = 0;
  		if(!defined($imagesfolder) || $imagesfolder eq ''){
  			$imagesfolder = 'img'; # image folders defaults to /img
  			$pathabbreviated = 1;
  		}
  		else{
	  		$imagefolderabbreviated = $imagesfolder;
	  		if($imagefolderabbreviated =~ m/^img\/(.*)$/){
		  		$imagefolderabbreviated = "$1/";
	  			$pathabbreviated = 1;
	  		}
		}

	  	# get a list of all files in the /img folder and its subfolders
	  	my $filesref =  $self->app->home->list_files($imagesfolder);

		my @images = ();
  		if(!defined($getthumbs) || !$getthumbs){
			# extracts all NON-thumbnail .jpg files located in $self->app->home->to_string/$imagesfolder (and not in /$imagesfolder subfolders)
  			@images = sort map /^(?!thumb)(.*?\d\d\d-\d+x\d+\.jpg)$/i, @{$filesref};
  		}
  		else{
			# extracts all thumbnail .jpg files located in $self->app->home->to_string/$imagesfolder (and not in /$imagesfolder subfolders)
  			@images = sort map /^thumb(.*?\d\d\d-\d+x\d+\.jpg)$/i, @{$filesref};
  		}

	  	my $seriesref = {}; # resulting data structure
		my ($dname,$dindex) = ('',-1);
		my @dwidths = (); 
		my @dheights = ();
		my $n = scalar @images; # number of elements
		my ($path,$name,$index,$width,$height,$datacomplete,$skip,$found) = (undef,undef,undef,undef,0,0,0);
		foreach my $image (@images){
			$n--;
			$image =~ m/^(.*?[\\\/]?)([^\\\/]+)(\d\d\d)-(\d+)x(\d+)\.jpg$/i;
			($path,$name,$index,$width,$height) = ($1,$2,$3,$4,$5);
			if(defined($seriesnames)){
				$skip = 0;
				$found = 0;
				my $seriesname;
				foreach $seriesname (@{$seriesnames}){
					if($seriesname !~ m/^!(.*)/){
						$found = 1; # found a non-exclude parameter: this means all includes must be defined in the array
					}					
				}
				if(!$found){
					push @{$seriesnames}, '*'; # only excludes are defined: this means by default we will includes all others
				}
				else{
					$found = 0;
				}
				foreach my $seriesname (@{$seriesnames}){
					if($seriesname =~ m/^!(.*)/){ # excludes start with '!'
						if(lc($name) eq lc($1)){ # case-insensitive
							$skip = 1;
							last;
						}
					}
					else{
						if(lc($name) eq lc($seriesname) || $seriesname eq '*'){ # includes
							$found = 1;
							last; # $skip remains 0
						}
					}
				}
				if(!$found){
					$skip = 1;
				}
				next if($skip && $n); # skips that image
			}
			if($dname eq ''){
				$dname = $name; 
			}elsif($name ne $dname){ # start of another series
				$datacomplete = 1;
			}
			if($dindex == -1){
				$dindex = $index;
			}elsif($index != $dindex){ # start of another index
				$datacomplete = 1;
			}
			if(!$datacomplete){
				push @dwidths, $width;
				push @dheights, $height;
			}
			if($datacomplete || !$n){ # we gathered all the data for the current index
				$seriesref->{$dname}->[$dindex-1]->{path} = $imagefolderabbreviated . $path;
				push @{$seriesref->{$dname}->[$dindex-1]->{w}}, @dwidths;
				push @{$seriesref->{$dname}->[$dindex-1]->{h}}, @dheights;
				$dname = $name;
				$dindex = $index;
				@dwidths = ();
				push @dwidths, $width;
				@dheights = (); 
				push @dheights, $height;
				if(!$n && !$skip){
					if($datacomplete){
						$seriesref->{$dname}->[$dindex-1]->{path} = $imagefolderabbreviated . $path;
						push @{$seriesref->{$dname}->[$dindex-1]->{w}}, @dwidths;
						push @{$seriesref->{$dname}->[$dindex-1]->{h}}, @dheights;
					}
				}
				else{
					$datacomplete = 0;
				}
			}
		}

		foreach $dname (keys %{$seriesref}){
			$imagesfolder = ($pathabbreviated ? 'img/' : '') . $seriesref->{$dname}->[0]->{path};
			next unless -e $self->app->home->rel_file("$imagesfolder/$dname.txt");
			my @lines = split '\n', slurp($self->app->home->rel_file("$imagesfolder/$dname.txt"));
			foreach my $line (@lines){
				my ($i,$c) = split ':', $line;
				$seriesref->{$dname}->[$i-1]->{caption} = $c;
			}
		}
		
    	return $seriesref; 
    });
}

sub getbytes {
  my ($pos, $buf, $numbytes) = @_;
  my $resultbuf = '';
  for(my $i=0; $i<$numbytes; $i++){
  	#$resultbuf .= pack "b*", unpack "x$pos b8", $buf;
  	$resultbuf .= pack "H*", unpack "x$pos H2", $buf; # probably more efficient!
  	$pos++;
  }
  return $resultbuf;
}

1;