{
This script is intended to replicate location information from the metadata to
catalog labels, more specific the Places category (by default). It is fairly
easy to customize the script to create the structure at any other place in the
catalog. For that, change the DetermineParentContainer function

The script will create 4 hierarchies inside the container:

1. photoshop:Country
2. --- photoshop:State
3. --- photoshop:City
4. --- Iptc4xmpCore:Location

For example:
1. Netherlands
2. --- Zuid Holland
3. --- Den Haag
4. --- Centrum


Author: HB van Zwietering
Last altered: 2014-07-21
Version: 1.4
Changes: 1.1; This version allows an easier way to change to a different parent
         instead of just the places category. Change the function
         DetermineParentContainer a little to better suit your needs. A few
         alternatives are already specified
         1.11; This version doesn't change the globar ParentGUID variable when
         storing the values
         1.12; This version fixes a bug that causes synonyms to be added to sub
         labels when multiple labels in the hierarchy are created
         1.20; This version also supports running this script on versioned images
         1.30; Made compatible with Photo Supreme
         1.40; This version also sets XMP mappings in the details of a prop
               Added an option (see cLowestLeafOnly) that allows to only assign
               the lowest level catalog label
}

const
  cLowestLeafOnly = 1;   // set to 1 to assign all location catalog labels

var
  AParentGUID: String;

  function DetermineParentContainer: String;
  var
    ACategory: TCatalogPropCategory;
    AProp: TCatalogItemProp;
  begin
    result := Catalog.Places.GUID;

    // alternative 1; find a category by name that should contain the places structure
    {
    ACategory := TCatalogPropCategory.Create (nil);
    if Catalog.EnumCategoryNamed ('Places', ACategory) then        // enable this line instead of the next on to find a category by name
      result := ACategory.GUID;
    ACategory.Free;
    }

    // alternative 2; find a catalog label by name that should contain the places structure
    {
    AProp := TCatalogItemProp.Create (nil);
    if Catalog.FindPropByName ('North America', AProp, '', True) then        // enable this line instead of the next on to find a category by name
      result := AProp.GUID;
    AProp.Free;
    }
  end;

  procedure StoreStructure (ACatItem: TCatalogItem; AStruct: TTntStringList);
  var
    AProp: TCatalogItemProp;
    i: Integer;
    AParent: String;
    AName: WideString;
    AMain: TCatalogItem;
  begin
    if AStruct.Count <> 4 then        // there should always be 4 entries
      exit;

    // always create the structure in the parent as determined as the ParentGUID
    AParent := AParentGUID;
    for i := 0 to AStruct.Count - 1 do
    begin
      AName := Trim(AStruct.Strings[i]);
      if AName = '' then
        AName := 'unknown';

      AProp := TCatalogItemProp.Create(nil);

      // is there an existing label with this name?
      if not Catalog.FindPropByName(AName, AProp, AParent, (i=0)) then  // find recursive for the first entry
      begin
        // not available yet, so create one
        AProp.GUID         := NewGUID;                    // generate a new GUID
        AProp.PropName     := AName;
        if i = 0 then
          AProp.PropXMPLink := 'photoshop:Country'
        else if i = 1 then
          AProp.PropXMPLink := 'photoshop:State'
        else if i = 2 then
          AProp.PropXMPLink := 'photoshop:City'
        else if i = 3 then
          AProp.PropXMPLink := 'Iptc4xmpCore:Location';
        if AProp.PropXMPLink <> '' then
          AProp.ParentXMPLinkAssign := True;
        Catalog.StorePropToDatabase (AProp, AParent, False);
      end;

      if (cLowestLeafOnly = 0) or (i = 3) then
      begin
        // Assign each of the labels to the catalog item
        if Catalog.ItemIsVersion(ACatItem) then
        begin
          AMain := TCatalogItem.Create(nil);
          if Catalog.FindMainVersionForItem (ACatItem, AMain) then
            Catalog.AddPropToItem (AMain, AProp, False, False);
          AMain.Free;
        end
        else
          Catalog.AddPropToItem (ACatItem, AProp, False, False);
      end;

      AParent := AProp.GUID;

      AProp.Free;
    end;
  end;

  procedure HandleItem (AItem: TImageItem);
  var
    ACatItem: TCatalogItem;
    AXmp: TXMP;
    AProp: TCatalogItemProp;
    AParam: TMacroParam;
    AStruct: TTntStringList;
    AFound: Boolean;
  begin
    AFound := False;
    ACatItem := TCatalogItem.Create (nil);
    AStruct := TTntStringList.Create;
    try
      // find the image item in the catalog (and only process found items)
      if Catalog.FindImageCombined (AItem, ACatItem, False, vptNone) then
      begin
        AXmp := TXMP.Create (nil);
        try
          Catalog.LoadXMPForItem (ACatItem, AXmp, Options.CachedXMP);

          // find the country
          AParam := AXmp.FindDesignProperty ('http://ns.adobe.com/photoshop/1.0/', 'photoshop:Country');
          if AParam <> nil then
          begin
            AStruct.Add (Nvl(AParam.Content, ''));
            AFound := True;
          end
          else
            AStruct.Add ('');

          // find the state
          AParam := AXmp.FindDesignProperty ('http://ns.adobe.com/photoshop/1.0/', 'photoshop:State');
          if AParam <> nil then
          begin
            AStruct.Add (Nvl(AParam.Content, ''));
            AFound := True;
          end
          else
            AStruct.Add ('');

          // find the city
          AParam := AXmp.FindDesignProperty ('http://ns.adobe.com/photoshop/1.0/', 'photoshop:City');
          if AParam <> nil then
          begin
            AStruct.Add (Nvl(AParam.Content, ''));
            AFound := True;
          end
          else
            AStruct.Add ('');

          // find the location
          AParam := AXmp.FindDesignProperty ('http://iptc.org/std/Iptc4xmpCore/1.0/xmlns/', 'Iptc4xmpCore:Location');
          if AParam <> nil then
          begin
            AStruct.Add (Nvl(AParam.Content, ''));
            AFound := True;
          end
          else
            AStruct.Add ('');

          // now we have stored the structure sequentially in the stringlist AStruct
          if AFound then
            StoreStructure (ACatItem, AStruct);
        finally
          AXmp.Free;
        end;
      end;
    finally
      ACatItem.Free;
      AStruct.Free;
    end;
  end;

var
  i: Integer;
begin
  AParentGUID := DetermineParentContainer;

  Progress.Cancel := False;
  Progress.Max := Selected.Count;
  Progress.Pos := 0;

  Progress.Show;
  for i := 0 to Selected.Count - 1 do
  begin
    Progress.Pos := i + 1;

    HandleItem (Selected.Items[i]);

    if Progress.Cancel then
      break;
  end;
  Progress.Hide;

  if Progress.Cancel then
    Say ('Cancelled.');
end;