package Farsi;

# Copyright (c) 2001-2002 Hamid Hashemi (hamid@morva.net).  All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

# Function gregorian_to_jalali and jalali_to_gregorian is adopted from Roozbeh Pournader's
# PHP functions and I have convert them to Perl ( http://sina.sharif.edu/~roozbeh/farsiweb )
###########################################################################
###########################################################################

use strict;
use warnings;
use POSIX qw( strftime );

BEGIN {
  use Exporter   ();
  our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

  # set the version for version checking
  $VERSION     = 0.01;

  @ISA         = qw(Exporter);
  @EXPORT      = qw(&farsi_code &iransystem2unicode &gregorian_to_jalali &g2jstrftime &jalali_to_gregorian);
  %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

  # your exported package globals go here,
  # as well as any optionally exported functions
  # @EXPORT_OK   = qw($Var1 %Hashit &func3);
}
our @EXPORT_OK;

# exported package globals go here
# our $Var1;
# our %Hashit;

# then the others (which are still accessible as $Some::Module::stuff)
# $stuff  = '';
# @more   = ();

# all file-scoped lexicals must be created before
# the functions below that use them.


# file-private lexicals go here
# my $priv_var    = '';
# my %secret_hash = ();
my @g_days_in_month = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
my @j_days_in_month = (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);


# here's a file-private function as a closure,
# callable as &$priv_func;  it cannot be prototyped.
my $div = sub {
  return int( $_[0] / $_[1] );
};

sub farsi_code($)
{
  my %code;
  $code{'،'} = '،';  # Persian Comma
  $code{'؟'} = '؟';  # Persian Question Mark
  $code{'ء'} = 'ء';  # Hamza
  $code{'آ'} = 'آ';  # Alef with Madda Above
  $code{'أ'} = 'أ';  # Alef with Hamza Above
  $code{'ؤ'} = 'ؤ';  # Waw with Hamza Above
  $code{'إ'} = 'إ';  # Alef with Hamza under Above
  $code{'ئ'} = 'ئ';  # Yeh with Hamza Above
  $code{'ا'} = 'ا';  # Alef
  $code{'ب'} = 'ب';  # Beh
  $code{'پ'} = 'پ'; # Peh
  $code{'ت'} = 'ت';  # Teh
  $code{'ث'} = 'ث';  # Theh
  $code{'ج'} = 'ج';  # Jeem
  $code{'چ'} = 'چ'; # Tcheh
  $code{'ح'} = 'ح';  # Hah
  $code{'خ'} = 'خ';  # Khah
  $code{'د'} = 'د';  # Dal
  $code{'ذ'} = 'ذ';  # Thal
  $code{'ر'} = 'ر';  # Reh
  $code{'ز'} = 'ز';  # Zain
  $code{'ژ'} = 'ژ'; # Jeh
  $code{'س'} = 'س';  # Seen
  $code{'ش'} = 'ش';  # Sheen
  $code{'ص'} = 'ص';  # Sad
  $code{'ض'} = 'ض';  # Dad
  $code{'ط'} = 'ط';  # Tah
  $code{'ظ'} = 'ظ';  # Zah
  $code{'ع'} = 'ع';  # Ain
  $code{'غ'} = 'غ';  # Ghain
  $code{'ف'} = 'ف';  # Feh
  $code{'ق'} = 'ق';  # Qaf
  $code{'ک'} = 'ک'; # Kaf
  $code{'گ'} = 'گ'; # Gaf
  $code{'ل'} = 'ل';  # Lam
  $code{'م'} = 'م';  # Meem
  $code{'ن'} = 'ن';  # Noon
  $code{'و'} = 'و';  # Waw
  $code{'ه'} = 'ه';  # Heh
  $code{'ي'} = 'ي';  # Yeh
  $code{'‏'} = ' ';   # Hard Space
  my $strout = '';
  foreach (split //,$_[0]) 
  { 
    if ( $code{$_} )
    {
      $strout .= $code{$_}; 
    }
    else
    {
      $strout .= $_;
    }
  }
  return $strout;
}

sub iransystem2unicode($)
{
  my %code;
  $code{"\x8A"}="،";  # Persian Comma
  $code{"\x8B"}="";   #
  $code{"\x8C"}="؟";  # Persian Question Mark
  $code{"\x8D"}="آ";  # Alef with Madda Above
  $code{"\x8E"}="ئ";  # Yeh with Hamza Above
  $code{"\x8F"}="ئ";  #  "    "    "     "
  $code{"\x90"}="ا";  # Alef
  $code{"\x91"}="ا";  #  "
  $code{"\x92"}="ب";  # Beh
  $code{"\x93"}="ب";  #  "
  $code{"\x94"}="پ"; # Peh
  $code{"\x95"}="پ"; #  "
  $code{"\x96"}="ت";  # Teh
  $code{"\x97"}="ت";  #  "
  $code{"\x98"}="ث";  # Theh
  $code{"\x99"}="ث";  #  "
  $code{"\x9A"}="ج";  # Jim
  $code{"\x9B"}="ج";  #  "
  $code{"\x9C"}="چ"; # Cheh
  $code{"\x9D"}="چ"; #  "
  $code{"\x9E"}="ح";  # Hah
  $code{"\x9F"}="ح";  #  "
  $code{"\xA0"}="خ";  # Khah
  $code{"\xA1"}="خ";  #  "
  $code{"\xA2"}="د";  # Dal
  $code{"\xA3"}="ذ";  # Thal
  $code{"\xA4"}="ر";  # Reh
  $code{"\xA5"}="ز";  # Zain
  $code{"\xA6"}="ژ"; # Jeh
  $code{"\xA7"}="س";  # Seen
  $code{"\xA8"}="س";  #   "
  $code{"\xA9"}="ش";  # Sheen
  $code{"\xAA"}="ش";  #   "
  $code{"\xAB"}="ص";  # Sad
  $code{"\xAC"}="ص";  #  "
  $code{"\xAD"}="ض";  # Dad
  $code{"\xAE"}="ض";  #  "
  $code{"\xAF"}="ط";  # Tah
  $code{"\xE0"}="ظ";  # Zah
  $code{"\xE1"}="ع";  # Ain
  $code{"\xE2"}="ع";  #  "
  $code{"\xE3"}="ع";  #  "
  $code{"\xE4"}="ع";  #  "
  $code{"\xE5"}="غ";  # Ghain
  $code{"\xE6"}="غ";  #   "
  $code{"\xE7"}="غ";  #   "
  $code{"\xE8"}="غ";  #   "
  $code{"\xE9"}="ف";  # Feh
  $code{"\xEA"}="ف";  #  "
  $code{"\xEB"}="ق";  # Qaf
  $code{"\xEC"}="ق";  #  "
  $code{"\xED"}="ک"; # Kaf
  $code{"\xEE"}="ک"; #  "
  $code{"\xEF"}="گ"; # Gaf
  $code{"\xF0"}="گ"; #  "
  $code{"\xF1"}="ل";  # Lam
  $code{"\xF2"}="لا"; #  " and Alef
  $code{"\xF3"}="ل";  #  "
  $code{"\xF4"}="م";  # Mim
  $code{"\xF5"}="م";  #  "
  $code{"\xF6"}="ن";  # Noon
  $code{"\xF7"}="ن";  #  "
  $code{"\xF8"}="و";  # Waw
  $code{"\xF9"}="ه";  # Heh
  $code{"\xFA"}="ه";  #  "
  $code{"\xFB"}="ه";  #  "
  $code{"\xFC"}="ي";  # Yeh
  $code{"\xFD"}="ي";  #  "
  $code{"\xFE"}="ي";  #  "
  my $strout = '';
  foreach ( reverse split //,$_[0] )
  {
    if ( $code{$_} )
    {
      $strout .= $code{$_};
    }
    else
    {
      $strout .= $_;
    }
  }
  return $strout;
}

sub gregorian_to_jalali($$$) # ( @_[0] = Gregorian_Year , @_[1] = Gregorian_Month , @_[2] = Gregorian_Day )
{
  my $i;
  my $gy = $_[0]-1600;
  my $gm = $_[1]-1;
  my $gd = $_[2]-1;
  
  my $g_day_no = 365*$gy+&$div($gy+3,4)-&$div($gy+99,100)+&$div($gy+399,400);
  
  for ($i=0; $i < $gm; ++$i)
  {
    $g_day_no += $g_days_in_month[$i];
  }
  $g_day_no++ if ($gm>1 && (($gy%4==0 && $gy%100!=0) || ($gy%400==0)));
  $g_day_no += $gd;

  my $j_day_no = $g_day_no-79;

  my $j_np = &$div($j_day_no, 12053); # 12053 = 365*33 + 32/4
  $j_day_no = $j_day_no % 12053;
  
  my $jy = 979+33*$j_np+4*&$div($j_day_no,1461); # 1461 = 365*4 + 4/4

  $j_day_no %= 1461;
  
  if ($j_day_no >= 366)
  {
    $jy += &$div($j_day_no-1, 365);
    $j_day_no = ($j_day_no-1)%365;
  }

  for ($i = 0; $i < 11 && $j_day_no >= $j_days_in_month[$i]; ++$i)
  {
    $j_day_no -= $j_days_in_month[$i];
  }
  my $jm = $i+1;
  my $jd = $j_day_no+1;

  return ( $jy, $jm, $jd );
}

sub g2jstrftime($$) # just Like strftime = ( @_[0] = pattern, @_[1] = timestamp )
{
  my $pattern = $_[0];

  my $g_y = strftime "%Y", localtime($_[1]);
  my $g_m = strftime "%m", localtime($_[1]);
  my $g_d = strftime "%d", localtime($_[1]);
  my $g_d_s = strftime "%a", localtime($_[1]);

  my ($j_y, $j_m, $j_d) = gregorian_to_jalali ($g_y, $g_m, $g_d);
  
  my ($j_d_s, $j_d_i);
  if ( $g_d_s eq 'Sat' ) { ($j_d_s, $j_d_i) = ('شنبه', 'شنبه') }
  elsif ( $g_d_s eq 'Sun' ) { ($j_d_s, $j_d_i) = ('يکشنبه', '1 شنبه') }
  elsif ( $g_d_s eq 'Mon' ) { ($j_d_s, $j_d_i) = ('دوشنبه', '2 شنبه') }
  elsif ( $g_d_s eq 'Tue' ) { ($j_d_s, $j_d_i) = ('سه شنبه', '3 شنبه') }
  elsif ( $g_d_s eq 'Wed' ) { ($j_d_s, $j_d_i) = ('چهارشنبه', '4 شنبه') }
  elsif ( $g_d_s eq 'Thu' ) { ($j_d_s, $j_d_i) = ('پنجشنبه', '5 شنبه') }
  elsif ( $g_d_s eq 'Fri' ) { ($j_d_s, $j_d_i) = ('جمعه', 'جمعه') }

  my $j_m_s;
  if ( $j_m eq '1' ) { $j_m_s = 'فروردين' }
  elsif ( $j_m eq '2' ) { $j_m_s = 'ارديبهشت' }
  elsif ( $j_m eq '3' ) { $j_m_s = 'خرداد' }
  elsif ( $j_m eq '4' ) { $j_m_s = 'تير' }
  elsif ( $j_m eq '5' ) { $j_m_s = 'مرداد' }
  elsif ( $j_m eq '6' ) { $j_m_s = 'شهريور' }
  elsif ( $j_m eq '7' ) { $j_m_s = 'مهر' }
  elsif ( $j_m eq '8' ) { $j_m_s = 'آبان' }
  elsif ( $j_m eq '9' ) { $j_m_s = 'آذر' }
  elsif ( $j_m eq '10' ) { $j_m_s = 'دي' }
  elsif ( $j_m eq '11' ) { $j_m_s = 'بهمن' }
  elsif ( $j_m eq '12' ) { $j_m_s = 'اسفند' }

  my $j_y_s = substr ($j_y,2,2);
  my $j_m_i = $j_m_s."ماه";

  $pattern =~ s/\%Y/$j_y/g; 
  $pattern =~ s/\%y/$j_y_s/g; 
  $pattern =~ s/\%m/$j_m/g;
  $pattern =~ s/\%b/$j_m_s/g;
  $pattern =~ s/\%B/$j_m_i/g;
  $pattern =~ s/\%d/$j_d/g;
  $pattern =~ s/\%a/$j_d_i/g;
  $pattern =~ s/\%A/$j_d_s/g;
  
  return $pattern;
}

sub jalali_to_gregorian($$$) # ( @_[0] = Jalali_Year , @_[1] = Jalali_Month , @_[2] = Jalali_Day )
{
  my $i;
  my $jy = $_[0]-979;
  my $jm = $_[1]-1;
  my $jd = $_[2]-1;

  my $j_day_no = 365*$jy + &$div($jy, 33)*8 + &$div($jy%33+3, 4);
  for ($i=0; $i < $jm; ++$i)
  {
    $j_day_no += $j_days_in_month[$i];
  }
  
  $j_day_no += $jd;

  my $g_day_no = $j_day_no+79;

  my $gy = 1600 + 400*&$div($g_day_no, 146097); # 146097 = 365*400 + 400/4 - 400/100 + 400/400
  $g_day_no = $g_day_no % 146097;

  my $leap = 1;
  if ($g_day_no >= 36525) # 36525 = 365*100 + 100/4
  {
    $g_day_no--;
    $gy += 100*&$div($g_day_no,  36524); # 36524 = 365*100 + 100/4 - 100/100
    $g_day_no = $g_day_no % 36524;
    
    if ($g_day_no >= 365)
    {
      $g_day_no++;
    }
    else
    {
      $leap = 0;
    }
  }

  $gy += 4*&$div($g_day_no, 1461); # 1461 = 365*4 + 4/4
  $g_day_no %= 1461;

  if ($g_day_no >= 366)
  {
    $leap = 0;
    
    $g_day_no--;
    $gy += &$div($g_day_no, 365);
    $g_day_no = $g_day_no % 365;
  }
  for ($i = 0; $g_day_no >= $g_days_in_month[$i] + ($i == 1 && $leap); $i++)
  {
    $g_day_no -= $g_days_in_month[$i] + ($i == 1 && $leap);
  }
  my $gm = $i+1;
  my $gd = $g_day_no+1;

  return ($gy, $gm, $gd);
}

END { }       # module clean-up code here (global destructor)

## YOUR CODE GOES HERE

1;  # don't forget to return a true value from the file