erlrcdynamic_appup.erl

%% @doc Dynamic hooks intended to be called from packaging systems.
%% Includes routines for starting, stopping, upgrading, and downgrading
%% applications.  Automatically generates requisite .appup files (only if
%% they don't exist already).
%% @end

-module (erlrcdynamic).
-export ([
         make_appup/5
         ]).

-include_lib ("kernel/include/file.hrl").

%% @spec make_appup (atom (), string (), string (), string (), string ()) -> { ok, AppUp } | { error, atom () }
%% @doc Automatically generate an appup file for the given application 
%% upgrading or downgrading between earlier version and later version.
%% Successful return contains a tuple which is a valid OTP appup specification.
%% @end

make_appup (Application, EarlierVersion, LaterVersion, EarlierDir, LaterDir) ->
  case file:consult (EarlierDir ++ "/ebin/" ++
                     atom_to_list (Application) ++ ".app")
  of
    { ok, [ { application, Application, EarlierProps } ] } ->
      case vsn (EarlierProps) =:= EarlierVersion of
        true ->
          case file:consult (LaterDir ++ "/ebin/" ++
                             atom_to_list (Application) ++ ".app")
    of
            { ok, [ { application, Application, LaterProps } ] } ->
              case vsn (LaterProps) =:= LaterVersion of
                true ->
      make_appup (Application,
            EarlierVersion,
            EarlierProps,
            LaterVersion,
            LaterDir,
            LaterProps);
                false ->
                  { error, bad_new_appvsn }
              end;
            _ ->
        { error, bad_new_appfile }
          end;
        false ->
          { error, bad_old_appvsn }
      end;
    _ ->
      { error, bad_old_appfile }
  end.

%%
%% Private
%%

make_appup (Application,
      EarlierVersion,
      EarlierProps,
      LaterVersion,
      LaterDir,
      LaterProps) ->
  AddMods = modules (LaterProps) -- modules (EarlierProps),
  DelMods = modules (EarlierProps) -- modules (LaterProps),

  { UpVersionChange, DownVersionChange } =
    case start_module (LaterProps) of
      { ok, StartMod, StartArgs } ->
  StartModBeamFile =
    LaterDir ++ "/ebin/" ++ atom_to_list (StartMod) ++ ".beam",
  { [ D
      || { ok, Beam } <- [ file:read_file (StartModBeamFile) ],
         D <- version_change (Beam,
            EarlierVersion,
            StartMod,
            StartArgs) ],
    [ D
      || { ok, Beam } <- [ file:read_file (StartModBeamFile) ],
         D <- version_change (Beam,
            { down, EarlierVersion },
            StartMod,
            StartArgs) ] };
      undefined ->
  { [], [] }
    end,

  UpDirectives =
    [ D
      || M <- modules (LaterProps) -- AddMods,
   BeamFile <- [ LaterDir ++ "/ebin/" ++ atom_to_list (M) ++ ".beam" ],
   { ok, Beam } <- [ file:read_file (BeamFile) ],
   D <- upgrade_directives (EarlierVersion, LaterVersion, M, Beam) ],

  DownDirectives =
    [ D
      || M <- lists:reverse (modules (LaterProps) -- AddMods),
   BeamFile <- [ LaterDir ++ "/ebin/" ++ atom_to_list (M) ++ ".beam" ],
   { ok, Beam } <- [ file:read_file (BeamFile) ],
   D <- downgrade_directives (EarlierVersion, LaterVersion, M, Beam) ],

  AppUp =
    { LaterVersion,
      [ { EarlierVersion,
    [ { add_module, M } || M <- AddMods ]
    ++ UpDirectives
    ++ UpVersionChange
    ++ [ { delete_module, M } || M <- DelMods ]
  }
      ],
      [ { EarlierVersion,
    [ { add_module, M } || M <- lists:reverse (DelMods) ]
    ++ DownVersionChange
    ++ DownDirectives
    ++ [ { delete_module, M } || M <- lists:reverse (AddMods) ]
  }
      ]
    },
  local_info_msg ("make_appup/6: generated AppUp for ~p ~p -> ~p~n~p~n",
      [ Application, EarlierVersion, LaterVersion, AppUp ]),
  { ok, AppUp }.


beam_exports (Beam, Func, Arity) ->
  case beam_lib:chunks (Beam, [ exports ]) of
    { ok, { _, [ { exports, Exports } ] } } ->
      lists:member ({ Func, Arity }, Exports);
    _ ->
      false
  end.

vsn (Props) ->
  { value, { vsn, Vsn } } = lists:keysearch (vsn, 1, Props),
  Vsn.

downgrade_directives (EarlierVersion, LaterVersion, M, Beam) ->
  case is_supervisor (Beam) of
    true ->
      downgrade_directives_supervisor (EarlierVersion, LaterVersion, M, Beam);
    false ->
      case has_code_change (Beam) of
        true  -> [ { update, M, infinity, { advanced, [] }, brutal_purge, brutal_purge, [] } ];
        false -> [ { load_module, M } ]
      end
  end.

downgrade_directives_supervisor (EarlierVersion, LaterVersion, M, Beam) ->
  case beam_exports (Beam, sup_downgrade_notify, 2) of
    true ->
      [ { apply,
	  { M, sup_downgrade_notify, [ EarlierVersion, LaterVersion ] } },
        { update, M, supervisor } ];
    false ->
      [ { update, M, supervisor } ]
  end.

has_code_change (Beam) ->
  beam_exports (Beam, code_change, 3).

has_element (Attr, Key, Elem) ->
  case lists:keysearch (Key, 1, Attr) of
    { value, { Key, Value } } ->
      lists:member (Elem, Value);
    _ ->
      false
  end.

has_version_change (Beam) ->
  beam_exports (Beam, version_change, 2).


is_supervisor (Beam) ->
  case beam_lib:chunks (Beam, [ attributes ]) of
    { ok, { _, [ { attributes, Attr } ] } } ->
      has_element (Attr, behaviour, supervisor) orelse
      has_element (Attr, behavior, supervisor);
    _ ->
      false
  end.

local_info_msg (Format, Args) ->
  Leader = erlang:group_leader (),
  try
    true = erlang:group_leader (self (), self ()),
    error_logger:info_msg (Format, Args)
  after
    erlang:group_leader (Leader, self ())
  end.

modules (Props) ->
  { value, { modules, Modules } } = lists:keysearch (modules, 1, Props),
  Modules.

start_module (Props) ->
  case lists:keysearch (mod, 1, Props) of
    { value, { mod, { StartMod, StartArgs } } } ->
      { ok, StartMod, StartArgs };
    false ->
      undefined
  end.

upgrade_directives (EarlierVersion, LaterVersion, M, Beam) ->
  case is_supervisor (Beam) of
    true ->
      upgrade_directives_supervisor (EarlierVersion, LaterVersion, M, Beam);
    false ->
      case has_code_change (Beam) of
        true  -> [ { update, M, infinity, { advanced, [] }, brutal_purge, brutal_purge, [] } ];
        false -> [ { load_module, M } ]
      end
  end.

upgrade_directives_supervisor (EarlierVersion, LaterVersion, M, Beam) ->
  case beam_exports (Beam, sup_upgrade_notify, 2) of
    true ->
      [ { update, M, supervisor },
        { apply,
    { M, sup_upgrade_notify, [ EarlierVersion, LaterVersion ] } } ];
    false ->
      [ { update, M, supervisor } ]
  end.

version_change (Beam, From, StartMod, StartArgs) ->
  case has_version_change (Beam) of
    true ->
      [ { apply, { StartMod, version_change, [ From, StartArgs ] } } ];
    false ->
      []
  end.