#!/usr/bin/perl -w

# This is fotowire.pl version 0.1, a free implementation of the FotoWire
# protocol and command-line client.
# Copyright (c) 2003 Matthieu Weber
#
# 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.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place - Suite 330, Boston, MA 02111-1307, USA.
# Or, point your browser to http://www.gnu.org/copyleft/gpl.html
#
# Author: Matthieu Weber
# E-mail: mweber@mit.jyu.fi

$DEBUG = 0;

$min_print_res = 150; # in dots/in
$config_dir   = "$ENV{HOME}/.fotowire";
$config_file  = "$config_dir/fotowirerc";
$session      = "$config_dir/session";
$log_file     = "$config_dir/log";
$debug_file   = "$config_dir/debug";
$labs_xml     = "$config_dir/labs.xml";
$labinfos_xml = "$config_dir/labinfos.xml";
$file_max_age = 86400; # in seconds


use HTTP::Request::Common;
use LWP::UserAgent;
use URI;
use XML::Twig;
use Unicode::MapUTF8 qw(from_utf8);
use Image::Info qw(image_info dim);

my @std_hdr = (
  'Connection'      => 'Keep-Alive',
  'Accept-Language' => 'en',
);

sub get_elt_text {
  my ($node, $gi) = @_;
  return from_utf8(-string => $node->first_child($gi)->text,
                   -charset => 'ISO-8859-1');
}

sub cmp_file_date {
  # returns -1 if f1 less recent than f2
  #          0 if f1   as recent as   f2
  #          1 if f1 more recent than f2
  my ($f1, $f2) = @_;
  return (stat($f1))[9] <=> (stat($f2))[9];
}

sub file_too_old {
  my $f = shift(@_);
  return (stat($f))[9] + $file_max_age < time();
}

sub log_open {
  open(LOG,">>$log_file");
  $log_opened = 1;
}

sub log_close {
  $log_opened = 0;
  close(LOG);
}

sub log {
  my $s = shift(@_);
  if ($log_opened) {
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    printf LOG "%04d/%02d/%02d %02d:%02d:%02d %s\n",
               $year+1900, $mon+1, $mday, $hour, $min, $sec, $s;
  }
  else {
    print STDERR "Log file is not opened!\n";
  }
}

sub debug {
  my $s = shift(@_);
  open(DEBUG, ">>$debug_file");
  print DEBUG localtime(time)."\n";
  print DEBUG "$s\n\n";
  close(DEBUG);
}

sub _die {
  my $s = shift(@_);
  print STDERR "$s. Exit.\n";
  &log("DIED $s");
  &log_close();
  exit(1);
}

sub code_url_param {
  my $s = shift(@_);
  $s =~ s/ /+/g;
  $s =~ s/[^A-Za-z0-9-]/sprintf("%%%x")/eg;
  return $s;
}


sub url {
  my ($scheme, $authority, $path, $query) = @_;
  my $u = URI->new;
  $u->scheme($scheme);
  $u->authority($authority);
  $u->path($path) if defined $path;
  $u->query_form(@{$query}) if defined $query;
  return $u->as_string();
}

sub check_status {
  my ($fun_name, $t) = @_;
  if ($t->root->first_child('Status')) {
    my $status = $t->root->first_child('Status')->first_child('Code')->text;
    if ($status != 0) {
      _die "$fun_name status = $status".": ".
           &get_elt_text($t->root->first_child('Status'), 'Description');
    }
  }
}

sub get_list_labs {
  &log("get_list_labs");
  my $req = GET &url("http",$master, "/fworder/listlabs3.asp",
                      [ 
                        "CN" => $customer_info{CountryCode},
                      ]
                    ),
                    @std_hdr;
  my $res = $ua->request($req);
  _die "get_list_labs failed" unless ($res->is_success);
  &save_xml_doc($labs_xml, $res->content);
  &parse_list_labs($res->content);
}

sub parse_list_labs {
  my $doc = shift(@_);
  my $t = XML::Twig->new();
  $t->parse($doc);
  my @lablist = $t->root->children('Lab');
  foreach $lab (@lablist) {
    my $id = &get_elt_text($lab,'ID');
    foreach $e ('Name', 'Addr', 'City', 'State', 'Zip', 'Ctry',
                'Tel', 'Fax', 'TargetCtry', 'InfoURL', 'Opt') {
      $labs{$id}->{$e} = &get_elt_text($lab,$e);
    }
  }
}

sub print_list_labs {
  print "\n***** Labs *****\n";
  foreach $l (sort {
      my $l1 = $labs{$a}->{Ctry} cmp $labs{$b}->{Ctry};
      if ($l1 == 0) {
        $labs{$a}->{Name} cmp $labs{$b}->{Name};
      }
      else {
        $l1;
      }
    } keys(%labs)) {
    printf "  %6d: [$labs{$l}->{Ctry}] $labs{$l}->{Name}, $labs{$l}->{City}\n", $l;
  }
  print "\n";
}

sub get_version {
  &log("get_version");
  my $res = $ua->request(
    GET &url("http", $master, "/fworder/fwver.asp",
        [
          "LID" => $lab_ID,
          "OEM" => $lab_ID,
          "UPID"=> $lab_ID,
          "VER" => '3.0.0.123',
          "RD"  => '98cc3',
        ]),
        @std_hdr,
  );
}

sub get_lab_url {
  &log("get_lab_url");
  my $req = GET &url("http", $master, "/fworder/getlaburl.asp",
                      [
                        "LID" => $lab_ID,
                        "RD"  => '98d5a',
                      ]
                    ),
                    @std_hdr;
  my $res = $ua->request($req);
  _die "get_lab_url failed" unless ($res->is_success);
  my $t = XML::Twig->new();
  $t->parse($res->content);
  &check_status("get_lab_url", $t);
  my @lablist = $t->root->children('Lab');
  foreach $lab (@lablist) {
    my $id = &get_elt_text($lab,'ID');
    foreach $e ('HTTPServer', 'HTTPPath') {
      $labs{$id}->{$e} = &get_elt_text($lab, $e);
    }
  }
}

sub get_lab_info {
  &log("get_lab_info");
  my @content = (
    "LID" => $lab_ID,
    "DID" => '',
    "RD"  => '98d96',
  );
  push @content, ( PROMO => $promo_code) if $promo_code;
  
  my $res = $ua->request(
    GET &url("http", $labs{$lab_ID}->{HTTPServer},
             $labs{$lab_ID}->{HTTPPath}."getlabinfo3.asp",
              \@content,
            ),
            @std_hdr
  );
  _die "get_lab_info failed" unless ($res->is_success);
  &save_xml_doc($labinfos_xml, $res->content);
  &parse_lab_info($res->content);
}

sub parse_lab_info {
  my $xml = shift(@_);
  my $t = XML::Twig->new();
  $t->parse($xml);
  my @lablist = $t->root->children('Lab');
  foreach $lab (@lablist) {
    my $lid = &get_elt_text($lab, 'ID');
    foreach $e ('Name', 'Addr', 'City', 'State', 'Zip', 'Ctry',
                'Tel', 'Fax', 'TargetCtry', 'InfoURL', 'HTTPServer',
                'HTTPPath', 'Currency', 'TaxInfoMsg', 'InfoMsg',
                'Opt', 'InfoMsgWeb', 'Validity', 'MinOrder') {
      next unless $lab->first_child($e);
      $labs{$lid}->{$e} = &get_elt_text($lab, $e);
    }
    my @pml = $lab->first_child('PayMethodList')->children('PayMethod');
    foreach $pm (@pml) {
      my $id = &get_elt_text($pm, 'ID');
      foreach $e ('Description', 'Explanation', 'CardType') {
        $labs{$lid}->{'PayMethod'}->{$id}->{$e} = &get_elt_text($pm, $e);
      }
    }
    my @pl = $lab->first_child('ProductList')->children('Product');
    foreach $p (@pl) {
      my $id = &get_elt_text($p,'ID');
      foreach $e ('Description', 'UnitPriceN', 'MinImageXRes', 'MinImageYRes',
                  'SizeX', 'SizeY') {
        $labs{$lid}->{'Product'}->{$id}->{$e} = &get_elt_text($p, $e);
      }
    }
    my @sml = $lab->first_child('ShipMethodList')->children('ShipMethod');
    foreach $sm (@sml) {
      my $id = &get_elt_text($sm,'ID');
      foreach $e ('Description', 'PriceN') {
        $labs{$lid}->{'ShipMethod'}->{$id}->{$e} = &get_elt_text($sm, $e);
      }
    }
  }
}

sub print_lab_basics {
  my $lid = shift(@_);
  print "Information for $labs{$lid}->{'Name'} ($lid):\n";
  print "  $labs{$lid}->{'Name'}\n";
  print "  $labs{$lid}->{'Addr'}\n";
  print "  $labs{$lid}->{'Zip'} $labs{$lid}->{'City'}\n";
  print "  $labs{$lid}->{'Ctry'}\n";
  print "  Tel: $labs{$lid}->{'Tel'}\n";
  print "  Fax: $labs{$lid}->{'Fax'}\n";
  print "\n";
  print "$labs{$lid}->{'MinOrder'}\n" if $labs{$lid}->{'MinOrder'};
  print "$labs{$lid}->{'InfoMsg'}\n" if $labs{$lid}->{'TaxInfoMsg'};
  print "$labs{$lid}->{'TaxInfoMsg'}\n" if $labs{$lid}->{'TaxInfoMsg'};
  print "$labs{$lid}->{'InfoMsgWeb'}\n" if $labs{$lid}->{'TaxInfoMsg'};
  print "\n";
  
}

sub print_lab_paymethod {
  my $lid = shift(@_);
  my %paymethod = %{$labs{$lid}->{'PayMethod'}};
  print "Pay methods for $labs{$lid}->{'Name'} ($lid):\n";
  foreach $id (keys(%paymethod)) {
    printf "  %4d: %s (%s)",  $id, $paymethod{$id}->{Description}, $paymethod{$id}->{Explanation};
    printf " [%s]", $paymethod{$id}->{CardType} if $paymethod{$id}->{CardType};
    print "\n";
  }
  print "\n";
}

sub print_lab_products {
  my $lid = shift(@_);
  my %product = %{$labs{$lid}->{'Product'}};
  print "Products for $labs{$lid}->{Name} ($lid):\n";
  foreach $id (sort {$product{$a}->{Description} cmp $product{$b}->{Description}} keys(%product)) {
    printf "  %4d: %-40s (> %4d x %4d)   %5.2f %s \n",  $id, $product{$id}->{Description},
             $product{$id}->{'MinImageXRes'}, $product{$id}->{'MinImageYRes'},
             $product{$id}->{'UnitPriceN'}, $labs{$lid}->{'Currency'};
  }
  print "\n";
}

sub print_lab_shipmethods {
  my $lid = shift(@_);
  my %shipmethod = %{$labs{$lid}->{'ShipMethod'}};
  print "Ship methods for $labs{$lid}->{Name} ($lid):\n";
  foreach $id (keys(%shipmethod)) {
    printf "  %4d: %-40s %s %s\n",  $id, $shipmethod{$id}->{Description},
              $shipmethod{$id}->{PriceN}, $labs{$lid}->{'Currency'};
  }
  print "\n";
}

sub post_customer_info {
  &log("post_customer_info");
  my @content = (
    LID => $lab_ID,
    CID => 0,
    PW  => '',
  );
  foreach $key (keys(%customer_info)) {
    push @content, ($key => $customer_info{$key});
  }
  
  my $req=  POST &url("http", $labs{$lab_ID}->{HTTPServer},
                      $labs{$lab_ID}->{HTTPPath}."customerset3.asp"),
                 \@content,
                 @std_hdr;
  my $res = $ua->request($req);
  _die "post_customer_info failed" unless ($res->is_success);
  my $t = XML::Twig->new();
  $t->parse($res->content);
  &check_status("post_customer_info", $t);
  open(SESSION,">$session") || _die "Cannot open session file $session";
  foreach $e ('ID', 'PW') {
    $customer_info{$e} = &get_elt_text($t->root->first_child('Customer'), $e);
    print SESSION "\$customer_info{$e} = $customer_info{$e};\n";
  } 
  print SESSION "1;\n";
  close(SESSION);
}

sub get_img_dim {
  my ($file) = @_;
  my $info = image_info($file);
  _die "Cannot parse image info: $info->{error}" if $info->{error};
  return dim($info);
}

sub eval_resolution {
  # This function is awful, and can probably be optimized
  # For now, we'll do with the comments
  my ($x, $y, $paper_x, $paper_y, $crop) = @_;

  # By default, we suppose the image and the paper are horizontal (landscape)
  my $img_horiz = 1;
  my $pap_horiz = 1;
  
  # Ratio of the sides of the image
  my $img_rap = $x / $y;
  if ($img_rap < 1) {
    # We want a number > 1
    $img_rap = 1 / $img_rap;
    # However, if the number was < 1, we know the image/paper was vertical
    # (portrait)
    $img_horiz = 0;
  }
  # And we want only 3 significative digits.
  $img_rap = int (100 * $img_rap) / 100;
  
  # Same as above, but with the paper
  my $pap_rap = $paper_x / $paper_y;
  if ($pap_rap < 1) {
    $pap_rap = 1 / $pap_rap;
    $pap_horiz = 0;
  }
  $pap_rap = int (100 * $pap_rap) / 100;
  
  # The ratio of the image length over paper length gives the horizontal
  # resolution. If one element was vertical and the other horizontal, we need
  # to swap the length and height of one of the elements.
  my $x_res = int(25.4 * $x / ($pap_horiz == $img_horiz ? $paper_x : $paper_y));
  # Same with vertical resolution
  my $y_res = int(25.4 * $y / ($pap_horiz == $img_horiz ? $paper_y : $paper_x));
  
  
  if ($img_horiz) {
    # If the image is horizontal, then the white bands are on the sides,
    # and the crop area is on top/bottom
    $crop_side = "top/bottom";
    $white_bands = "left/right";
  }
  else {
    # Inverse of the above if the image is vertical
    $crop_side = "left/right";
    $white_bands = "top/bottom";
  }
  
  if ($img_rap < $pap_rap) {
    # If the image ratio is lower than the paper ratio (i.e. 4:3 image in a
    # 3:2 paper), and if the image is cropped and if the image is horizontal,
    # then the image resolution is x_res; otherwise it is y_res
    return $crop ? ($img_horiz ? $x_res : $y_res, "cropped ".$crop_side) : ($img_horiz ? $y_res : $x_res, "white bands ".$white_bands);
  }
  elsif ($img_rap == $pap_rap) {
    # This is if the image fits perfectly the paper
    return ($x_res, "");
  }
  else {
    # This is unlikely to happen (unless we put a panorama image in a 4:3
    # or 3:2 paper)
    return $crop ? ($img_horiz ? $y_res : $x_res, "cropped".$crop_side) : ($img_horiz ? $x_res : $y_res, "white bands".$white_bands);
  }
}

sub read_order_from_file {
  &log("read_order_from_file");
  my $order_file = shift(@_);
  my $silent = shift(@_);
  open(ORDER,"$order_file") || _die "Cannot open order $order_file";
  my $header = 1;
  my $line_count = 1;
  my $item_count = 0;
  print "\n***** Your order *****\n" unless $silent;
  while(<ORDER>) {
    s/\r?\n//;
    if ($header) {
      if ($_ eq "") {
        $header = 0;
        print "Items:\n" unless $silent;
      }
      else {
        my ($k, $v) = split(/\s+/);
        if ($k =~ /ShipMethod|PayMethod/ && $v =~ /\d+/) {
          $order{$k} = $v;
          _die "Illegal value for $k in $order_file, line $line_count" unless exists $labs{$lab_ID}->{$k}->{$v};
          print "$k: $labs{$lab_ID}->{$k}->{$v}->{'Description'}\n" unless $silent;
        }
        else {
          _die "Syntax error in $order_file, line $line_count";
        }
      }
    }
    else {
      my ($pid, $qty, $file) = (/^(\S+)\s+(\S+)\s+(.*)$/);
      _die "Product ID '$pid' is not a number in $order_file, line $line_count" unless $pid =~ /^\d+$/;
      _die "Quantity '$qty' is not a number in $order_file, line $line_count" unless $qty =~ /^\d+$/;
      my $opts = "";
      ($file, $opts, $opts_arg) = ($1, $2, $3) if ($file =~ /(.*) (crop|nocrop) ?(.*)$/);
      my ($x, $y) = &get_img_dim($file);
      _die "File $file does not exist in $order_file, line $line_count" unless -e $file;
      _die "Product $pid does not exist in $order_file, line $line_count" unless exists $labs{$lab_ID}->{'Product'}->{$pid};
      _die "Option $opts does not exist in $order_file, line $line_count" unless $opts =~ /^crop$|^nocrop$/ || $opts eq "";
      my ($min_x, $min_y) = ($labs{$lab_ID}->{'Product'}->{$pid}->{'MinImageXRes'},
                             $labs{$lab_ID}->{'Product'}->{$pid}->{'MinImageYRes'});
      ($min_x, $min_y) = ($min_y, $min_x) if (($x < $y) && ($min_x > $min_y)) || (($x > $y) && ($min_x < $min_y));
      _die sprintf "The resolution of file %s (%d x %d) is below the limit for the chosen format (%d x %d)",
                      $file, $x, $y, $min_x, $min_y if $x < $min_x || $y < $min_y;
      $order{items}->[$item_count]->{'ProductID'} = $pid;
      $order{items}->[$item_count]->{'Quantity'} = $qty;
      $order{items}->[$item_count]->{'File'} = $file;
      $order{items}->[$item_count]->{'X'} = $x;
      $order{items}->[$item_count]->{'Y'} = $x;
      my ($res, $aspect) = eval_resolution($x, $y, $labs{$lab_ID}->{'Product'}->{$pid}->{'SizeY'},
                                        $labs{$lab_ID}->{'Product'}->{$pid}->{'SizeX'},
                                        $opts eq "crop" ? 1 : 0);
      printf "  %2d x %-35s [%-35s]\n       Res: %d dpi %s%s\n\n",
             $qty, $file, $labs{$lab_ID}->{'Product'}->{$pid}->{'Description'},
             $res, $res < $min_print_res ? "LOW RES ":"", $aspect unless $silent;
      $order{items}->[$item_count]->{'CT'} = 1;
      $order{items}->[$item_count]->{'CB'} = 1;
      $order{items}->[$item_count]->{'CL'} = 1;
      $order{items}->[$item_count]->{'CR'} = 1;
      $order{items}->[$item_count]->{'QW'} = 1;
      $order{items}->[$item_count]->{'FC'} = 0;
      $item_count ++;
    }
    $line_count ++;
  }
  close(ORDER);
  _die "Order is empty!" unless exists $order{items};
}

sub post_order_evaluate {
  &log("post_order_evaluate");
  my @content = (
    LID => $lab_ID,
    CID => $customer_info{ID},
    CPW => $customer_info{PW},
    SID => $order{ShipMethod},
    AID => $order{PayMethod},
    OEM => $lab_ID,
  );
  foreach $item (@{$order{items}}) {
    push @content, ( 
      PID => $item->{ProductID}, 
      Q => $item->{Quantity}
    );
  }

  my $req = POST &url("http", $labs{$lab_ID}->{HTTPServer},
                      $labs{$lab_ID}->{HTTPPath}."orderevaluate3.asp"),
                 \@content,
                 @std_hdr;
  &debug($req->as_string());
  my $res = $ua->request($req);
  _die "post_order_evaluate failed" unless ($res->is_success);
  &debug($res->as_string);
  my $t = XML::Twig->new();
  $t->parse($res->content);
  &check_status("post_order_evaluate", $t);
  print "\n***** Order evaluation *****\n";
  print &get_elt_text($t->root, 'Information')."\n\n";
  my @items = $t->root->first_child('ItemList')->children('Item');
  foreach $i (@items) {
    print "\n",next if $i->is_empty;
    print &get_elt_text($i,'Description').": ".
          &get_elt_text($i,'UnitPrice')." x ".
          &get_elt_text($i,'Quantity')." = ".
          &get_elt_text($i,'Price')." $labs{$lab_ID}->{'Currency'}\n";
  }
  print "\n";
  my @totals = $t->root->first_child('TotalList')->children('Item');
  foreach $i (@totals) {
    print "\n",next if $i->is_empty;
    print &get_elt_text($i,'Description').": ".
          &get_elt_text($i,'Price')." $labs{$lab_ID}->{'Currency'}\n";
  }
}

sub post_order_start {
  &log("post_order_start");
  my $proto = 'http';
  my $pay_by_card = $labs{$lab_ID}->{PayMethod}->{$order{PayMethod}}->{CardType} eq ''?0:1;
  $proto = 'https' if $pay_by_card;

  my @content = (
    LID => $lab_ID,
    CID => $customer_info{ID},
    CPW => $customer_info{PW},
    SID => $order{ShipMethod},
    AID => $order{PayMethod},
    OEM => $lab_ID,
  );
  if ($pay_by_card) {
    push @content, (
      CN => $card_info{Number},
      CEM => $card_info{ExpirationMonth},
      CEY => $card_info{ExpirationYear},
      CO => $card_info{OwnerName},
    );
  }
  else {
    push @content, (
      CN => '',
      CEM => '',
      CEY => '',
      CO => ''
                   );
  }
  my $req= POST &url($proto, $labs{$lab_ID}->{HTTPServer},
                     $labs{$lab_ID}->{HTTPPath}."orderstart3.asp"),
                \@content, @std_hdr;
  my $res = $ua->request($req);
  _die "post_order_start failed" unless ($res->is_success);
  &debug($res->content);
  my $t = XML::Twig->new();
  $t->parse($res->content);
  &check_status("post_order_start", $t);
  foreach $e ('SessionID', 'NextFileName', 'HTTPUplServer', 'HTTPUplPath',
              'FTPServer', 'FTPPath') {
    $order{$e} = &get_elt_text($t->root,$e);
  }
}

sub post_file_upload {
  &log("post_file_upload");
  my $item_number = shift(@_);
  my $res = $ua->request(
    POST &url("http", $order{HTTPUplServer},
              $order{HTTPUplPath}."newimage3.asp"),
        Content_Type => 'form-data',
        Content => [
          SRV  => $labs{$lab_ID}->{HTTPServer},
          PATH => $labs{$lab_ID}->{HTTPPath},
          OID  => $order{SessionID},
          PID  => $order{items}->[$item_number]->{'ProductID'},
          Q    => $order{items}->[$item_number]->{'Quantity'},
          FS   => (stat($order{items}->[$item_number]->{'File'}))[7],
          FC   => $order{items}->[$item_number]->{'FC'},
          IX   => $order{items}->[$item_number]->{'X'},
          IY   => $order{items}->[$item_number]->{'Y'},
          QW   => $order{items}->[$item_number]->{'QW'},
          CL   => $order{items}->[$item_number]->{'CL'},
          CT   => $order{items}->[$item_number]->{'CT'},
          CR   => $order{items}->[$item_number]->{'CR'},
          CB   => $order{items}->[$item_number]->{'CB'},
          FILE => [ $order{items}->[$item_number]->{'File'} ],
        ], @std_hdr
  );
  _die "post_file_upload failed" unless ($res->is_success);
  &debug($res->content);
  my $t = XML::Twig->new();
  $t->parse($res->content);
  &check_status("post_file_upload", $t);
  foreach $e ('SessionID', 'NextFileName') {
    $order{$e} = &get_elt_text($t->root, $e);
  }
}

sub get_order_confirm {
  &log("get_order_confirm");
  my $res = $ua->request(
    GET &url("http", $labs{$lab_ID}->{HTTPServer},
             $labs{$lab_ID}->{HTTPPath}."getlabinfo3.asp",
             [
               "OID" => $order{SessionID},
             ]
            ), @std_hdr
  );
  _die "get_order_confirm failed" unless ($res->is_success);
  &debug($res->content);
  my $t = XML::Twig->new();
  $t->parse($res->content);
  &check_status("get_order_confirm", $t);
  print "\n***** Order summary *****\n";
  print &get_elt_text($t->root, 'Information')."\n\n";
  my @items = $t->root->first_child('ItemList')->children('Item');
  foreach $i (@items) {
    print "\n" if $i->is_empty;
    print &get_elt_text($i,'Description').": ".
          &get_elt_text($i,'UnitPrice')." x ".
          &get_elt_text($i,'Quantity')." = ".
          &get_elt_text($i,'Price')." $labs{$lab_ID}->{'Currency'}. Sent: ".
          &get_elt_text($i,'Sent')."\n";
  }
  print "\n";
  my @totals = $t->root->first_child('TotalList')->children('Item');
  foreach $i (@totals) {
    next if $i->is_empty;
    print &get_elt_text($i,'Description').": ".
          &get_elt_text($i,'Price')." $labs{$lab_ID}->{'Currency'}\n";
  }
  print "\n";
  my $ord = $t->root->first_child('Order');
  print "Order ID: " . &get_elt_text($ord, 'OrderID')."\n";
  print "Amount: " . &get_elt_text($ord, 'Amount')." $labs{$lab_ID}->{'Currency'}\n";
  print "Pay method: " . &get_elt_text($ord, 'PayMethod')."\n";
  print "Ship method: " . &get_elt_text($ord, 'ShipMethod')."\n";
  my $lab = $ord->first_child('Lab');
  print "Lab address:\n";
  print "  ".&get_elt_text($lab, 'Name')."\n";
  print "  ".&get_elt_text($lab, 'Addr')."\n";
  print "  ".&get_elt_text($lab, 'Zip')." ".&get_elt_text($lab, 'City')."\n";
  print "  ".&get_elt_text($lab, 'Ctry')."\n";
  print "  Tel: ".&get_elt_text($lab, 'Tel')."\n";
  print "  Fax: ".&get_elt_text($lab, 'Fax')."\n";
  print "Confirmed: " . (&get_elt_text($ord, 'Confirmed') == 1?"Yes":"No")."\n";
  print &get_elt_text($ord, 'ClosingMessage')."\n";
}

sub save_xml_doc {
  my ($file, $xml) = @_;
  open(FILE, ">$file") || _die "Cannot open file $file for writing";
  print FILE $xml;
  close(FILE);
}

sub read_xml_doc {
  my $file = shift(@_);
  open(FILE, "$file") || _die "Cannot open file $file for reading";
  $oldRS = $/;
  undef $/;
  my $xml = <FILE>;
  $/ = $oldRS;
  close(FILE);
  return $xml;
}

sub write_fotowirerc {
  open(RC,">$config_file");
  print RC
"\# fotowirerc
\# Configuration file for fotowire
\# \%customer_info and \%card_info are Perl hashtables,
\# \$lab_ID and \$promo_code are Perl scalars.
\# Don't forget to escape the \@ in e-mail addresses!

\# \$lab_ID = \"1100\";
\# \$promo_code = \"\";

\%customer_info = (
Title           => \"\",
FirstName       => \"\",
LastName        => \"\",
Address1        => \"\",
Address2        => \"\",
City            => \"\",
StateOrProvince => \"\",
PostalCode      => \"\",
CountryCode     => \"FIN\",
PhoneNumber     => \"\",
FaxNumber       => \"\",
EmailAddress    => \"\",
LabCustomerID   => \"\",
DenyEmail       => 1,
);

\%card_info = (
Number          => \"\",
ExpirationMonth => \"\",
ExpirationYear  => \"\",
OwnerName       => \"\",
);

1;
";
  close(RC);
}

#############################################################################
### Main
#############################################################################

&log_open();
mkdir($config_dir,0700) || _die "Cannot create config directory" unless -e $config_dir;

if (! -e $config_file) {
  &write_fotowirerc();
  _die "No config file found, I created an empty one.
Fill it before continuing";
}
else {
  require "$config_file";
  _die "Config file exists, but seems empty" unless $customer_info{'LastName'};
}

if ($DEBUG) {
  $master = "localhost:8000";
  if (exists $labs{$lab_ID}) {
    $labs{$lab_ID}->{HTTPServer} = $master;
    $labs{$lab_ID}->{HTTPPath} = "/";
  }
}
else {
  $master = "master.fotowire.com";
}

$ua = LWP::UserAgent->new;
$ua->agent("fwClient(3.0.0.123;ENU;1100) OS(5.0.2195;FIN;WinNT)".
           " WinInet(5.0.2920.0) Browser(5.0.2920.0;;IE)");
$ua->protocols_allowed( [ 'http', 'ftp', 'https' ]);

# 1. Get a list of all labs
if (! -e $labs_xml || 
     (-e $labs_xml && 
       ( &cmp_file_date($labs_xml,$config_file) < 0 || 
         &file_too_old($labs_xml)
       )
     )
   ) {
  &get_list_labs();
}
else {
  &parse_list_labs(&read_xml_doc($labs_xml));
}
if (!$lab_ID) {
  print "Please configure fotowire so that it uses one of the following labs:\n";
  &print_list_labs();
}
else {
  # 2. Get version (useless ?)
  #&get_version();
  
  # 3. Get info about the selected lab (products and prices)
  &parse_lab_info(&read_xml_doc($labinfos_xml)) if (-e $labinfos_xml);
  if (! -e $labinfos_xml ||
       (-e $labinfos_xml && 
         ( &cmp_file_date($labinfos_xml,$config_file) < 0 ||
           &file_too_old($labinfos_xml)
         )
       ) ||
       ! exists $labs{$lab_ID}->{'Product'}
     ) {
    # 3.1 Get the URL parameters for getting the info
    if ($DEBUG) {
      print "FAKE GET_LAB_URL\n";
      $labs{$lab_ID}->{HTTPServer} = $master;
      $labs{$lab_ID}->{HTTPPath} = "/";
    }
    else {
      &get_lab_url();
    }
    # 3.2 Get the actual info
    &get_lab_info();
  }

  if ($#ARGV == -1) {
    print "\n***** Lab information *****\n";
    &print_lab_basics($lab_ID);
    &print_lab_paymethod($lab_ID);
    &print_lab_products($lab_ID);
    &print_lab_shipmethods($lab_ID);
    exit (0);
  }
}
if ($#ARGV == 1) {
  _die "Order file $ARGV[1] does not exist !" unless -e $ARGV[1];
  if ($ARGV[0] eq "check") {
    # 4. Parse the order from user
    &read_order_from_file($ARGV[1], 0);
  }
  elsif ($ARGV[0] eq "eval") {
    if ($DEBUG) {
      $labs{$lab_ID}->{HTTPServer} = $master;
      $labs{$lab_ID}->{HTTPPath} = "/";
    }

    &read_order_from_file($ARGV[1], 1);
    # 5. Post customer info
    &post_customer_info(); # unless -e $session;
    sleep (1);

    # 6. Post order info for price evaluation
    &post_order_evaluate ();
    sleep (1);
  }
  elsif ($ARGV[0] eq "send") {
    _die "No session found. Have you run 'fotowire.pl your_order' first?" unless -e $session;
    require "$session"; 
    &read_order_from_file($ARGV[1], 1);
    if ($DEBUG) {
      $labs{$lab_ID}->{HTTPServer} = $master;
      $labs{$lab_ID}->{HTTPPath} = "/";
    }
    # 7. Post the start of order signal
    &post_order_start();
    sleep (1);
    if ($DEBUG) {
      $order{HTTPUplServer} = $master;
      $order{HTTPUplPath} = "/";
    }

    # 8. Upload all the files
    print "\n***** File upload *****\n";
    my @items = $order{items};
    for($i=0; $i <= $#items; $i++) {
      print "Sending item $i: $order{items}->[$i]->{'File'}\n";
      &post_file_upload($i);
      sleep (1);
    }
    print "All files uploaded!\n";

    # 9. Get the confirmation of the order
    &get_order_confirm();
    unlink($session);
  }
  else {
    print STDERR "Usage: fotowire.pl your_order {check|eval|send}\n";
    _die "Incorrect syntax";
  }
}
else {
  print STDERR "Usage: fotowire.pl\n       fotowire.pl your_order {check|eval|send}\n";
  _die "Incorrect syntax";
}
&log_close()
